perm filename APE[AP,SYS]17 blob
sn#057428 filedate 1973-08-05 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00054 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00005 00002 Definitions.
C00008 00003 More definitions.
C00013 00004 Storage allocations for statistics keeping.
C00017 00005 LOOKUP/ENTER blocks.
C00019 00006 Storage arrays, dump mode commands, OPEN blocks.
C00022 00007 Special data words.
C00025 00008 Initialization.
C00028 00009 Initialization.
C00030 00010 Type out APMESS file, if any.
C00033 00011 Initialization.
C00035 00012 Start of main loop: asking for keywords. REESET RSTART APE1
C00037 00013 Check for various kinds of keyword expressions.
C00040 00014 Set up main story list and report nbr of stories found.
C00044 00015 Read in story selection line.
C00047 00016 Process rest of selection line.
C00050 00017 Read in story selection numbers and build up sublist of selected stories.
C00052 00018 Build up a list of the stories selected.
C00054 00019 Finish building up story sublist.
C00059 00020 LOOKUP output file to see if it already exists, then ENTER it.
C00062 00021 Read in the stories found: TYPEM
C00064 00022 Allow choosing stories. TYP7 TYP14 TYP10
C00067 00023 Put story into output file. TYP9 TYPE1
C00070 00024 Get next story in list. TYP18 GETNXT DIR8
C00073 00025 TERM MINUS PLUS FACTOR PRIMAR INTRPT CINT ESCI
C00077 00026 GETWD
C00080 00027 FOUND FINWD SAVPOL
C00082 00028 NONE NOTFND NOMULT ASKSRC
C00085 00029 READWD
C00088 00030 READ READY GETCH
C00091 00031 GETAVL NUNAVL GTORIG REENT
C00094 00032 ADORIG RETLST
C00097 00033 SETUPI SETUP NEXT1 NEXT2
C00099 00034 SDIFF
C00100 00035 UNION
C00101 00036 INTER
C00102 00037 COPY1 COPY2 FINISH
C00104 00038 LATEST SEQNBR
C00108 00039 GETSTY INNBR RDNBR PTZERO PRNTNO NXTDG PTREST
C00110 00040 PUTDAT CLEARU
C00112 00041 GETDAT PTIME
C00114 00042 PRINTU
C00117 00043 ZEROUS
C00118 00044 SAVPPN
C00120 00045 READIT
C00124 00046 SEARCH
C00128 00047 LOOK
C00134 00048 SHRINK UUCODE
C00136 00049 TELLKY TELLSL TELLSC
C00146 00050 NOTE
C00156 00051 NOTEDL NOTEDP
C00172 00052 TYKEYS
C00174 00053 READFL RFAUTO RFCON
C00181 00054 RFERR1-5 RFNAME
C00183 ENDMK
C⊗;
;Definitions.
TITLE APE
ARPA←←0 ;ARPA NON-ZERO MEANS TYPE OUT SPECIAL MESSAGE TO NETWORK USERS.
EXTERN SPOOLM,JOBREN,JOBAPR,JOBFF,JOBSA,JOBDDT
;ACCUMULATOR ASSIGNMENTS
F ←← 0 ;AC0 contains flags in the left half and "@" in the right half
A ← 1 ;temporary AC
B ← 2 ;temporary AC
C ← 3 ;temporary AC
D ← 4 ;temporary AC
TXTPTR←← D ;pointer into block for storage of characters of keywords
CHAR ← 6 ;current tty input character
SOR ← 7 ;pointer into list of keywords (SORDID)
DICTWD ←10 ;pointer to current DICT entry
PT1 ←11 ;first 5 chars of keyword, or first operand in a set operation
PT2 ←12 ;next 5 chars of keyword, or second operand in a set operation
PT3 ←13 ;next 5 chars of keyword, or resultant list of a set operation
PT4 ←14 ;next 5 chars of keyword
PT5 ←15 ;
X ←← PT1 ;pointer into the INDEX file
DISPL ←← PT2 ;displacement of current story in NEWS from record boundary
SIZE ←← PT4 ;size of the current news story
X1 ←← PT4 ;index of current story in first list
X2 ←← PT5 ;index of current story in second list
FIRST ←16 ;pointer to first part of keyword in WORDS (points to prev word)
STYPTR←← FIRST;
P ←17 ;push down list pointer
LF←←12 CR←←15 FF←←14 ALT←←175 TAB←←11
SPECS←←4 ;the next 7 lines must be duplicated in most AP programs
XSIZE←←3
MAXNBR←←=500
XLEN←MAXNBR*XSIZE+SPECS
WLEN←←6400
LLEN←←10000
DLEN←←6000 ;last line that must be duplicated
SLSTLN←←=750 ;length of the story list array (STYLST)
SLEN←←=15 ;length of the SORDID array
PDLEN←←=100 ;length of the pdl
STLEN←←2200 ;length of the block for holding stories in core
DEFINE UNDUNX {INDEX} ;first word in INDEX file
DEFINE NEWX {INDEX+1} ;second word
DEFINE OLDX {INDEX+2} ;third word
;More definitions.
;LEFT HALF FLAGS
DONT ←← 1 ; 0 if the stories should be typed out, 1 if they should not be
SPOOL ←← 2 ; 1 if output file should be spooled
SAVFIL←← 4 ; 1 if the output file should be saved
OP1FLG←← 10 ;bits indicating what kind of lists the operands are in a set
OP2FLG←← 20 ; operation. 1 means ptr into STYLST, 0 means ptr into LINKS.
XTND ←← OP1FLG ; 1 if the user wants output file added to (extended) with stories
REPL ←← OP2FLG ; 1 if the user wants output file to replace any file of same name
MINUS1←← 40 ; 1 if the 1st story number was preceeded by a minus sign
MINUS2←← 100 ; 1 if the 2nd story number was preceeded by a minus sign
PAIR ←← 200 ; 1 if two story selection numbers were typed in
ORDER ←← 400 ; 1 if the stories are to come out in reversed order
FEW ←← 2000 ; 1 if the user wants only the first few lines of each story
CHOOSE←← 4000 ; 1 if the user wants to choose if he wants to read rest of story
LSTFEW←← 10000 ; 1 if the user wants only the last few lines of each story
SEL ←← 20000 ; 1 if the user has already made a story selection from current list
SELNUN←← 40000 ; 1 if the user wants has selected none of the stories
KEYS ←← 100000 ; 1 if the user wants the keywords for each story typed out
DELB ←← 200000 ; 1 if the users is deleting notif requests in addition to displaying them
NOTIFY←← 400000 ; 1 if the user wants to be notified when a story matches his expr
TYPOUT← DONT!SPOOL!SAVFIL!FEW!LSTFEW!CHOOSE
;RIGHT HALF FLAGS (CANT USE LOW ORDER 7 BITS!)
GOD ←← 400000 ; 1 if the user is AP,SYS
TMPB ←← 200000 ; temporary flag
PPNDUN←← 100000 ; 1 if the user's ppn has been written in the USERS file
INFILE←← 40000 ; 1 if there is a command file open
CON ←← 20000 ; 1 if there is a command file open and the last expr ended with ","
AUTOCN←← 10000 ; 1 if keyword exprs should automatically be taken from cmd file
AUTOSC←← 4000 ; 1 if unrecognized keywords should automatically be searched for
TYPEFL←← 2000 ; 1 if stuff read from command file should be typed out
FROMFL←← 1000 ; 1 if last keyword expression was read from a command file
TMPB2 ←← 400 ; temporary flag
TMPB3 ←← 200 ; temp flag
;UNUSABLE←← 177
LOC 41
JSR UUCODE
LOC
OPDEF UERR1 [001000,,];minor error. type out message and jump to APE1
OPDEF UERR2 [002000,,];moderate error. type out message and jump to RSTART
OPDEF UERR3 [003000,,];big error. type out message and jump to REESET
OPDEF UBIGERR [004000,,];horrendous error. type out message and exit
DEFINE MEDERR(MSG) <UERR2 [ASCIZ\MSG\]>
DEFINE LGEERR(MSG) <UERR3 [ASCIZ\MSG\]>
DEFINE ECHOFF {PTYUUO 16,[0↔3]} ;PTJOBX--this turns off echoing of type-in
DEFINE ECHON {PTYUUO 16,[0↔4]} ;this turns it back on
;Storage allocations for statistics keeping.
DEFINE NAMES {
XXX URAPE ,TIMES "R APE" TYPED.....................
XXX UEXPR ,NORMAL EXPRESSIONS......................
XXX UNULL ,NULL EXPRESSIONS..................(CR)..
XXX USTAR ,CONTINUED EXPRESSIONS..............(*)..
XXX UPLUS ,CONTINUED EXPRESSIONS..............(+)..
XXX UMINUS,CONTINUED EXPRESSIONS..............(-)..
XXX UCONLF,EXPRESSIONS CONTINUED.............(LF)..
XXX UNOTIF,NOTIFICATION REQUESTS..........($expr)..
XXX UNDSPY,NOTIFICATION REQUESTS DISPLAYED....($)..
XXX UNSTOP,NOTIFICATION REQUESTS DELETED.....($$)..
XXX UATFL ,COMMAND FILES REFERENCED...........(@)..
XXX UFLXP,{COMMAND FILE EXPRESSIONS USED......(;)..}
XXX UFLSL,{COMMAND FILE SELECTION LINES.......(,)..}
XXX UTYP ,WHOLE STORIES TYPED OUT.................
XXX UFEW ,FIRST FEW LINES TYPED OUT..........(F)..
XXX UCHSF ,STORIES CHOSEN FROM................(C)..
XXX UCHS ,STORIES CHOSEN..........................
XXX ULST ,LAST FEW LINES TYPED OUT...........(L)..
XXX USPL ,STORIES SPOOLED....................(S)..
XXX UFIL ,STORIES SAVED IN FILES.......(filenm←)..
XXX UKEYS ,TIMES KEYWORDS TYPED OUT...........(W)..
XXX UUNREC,UNRECOGNIZED KEYWORDS (NO SEARCH).......
XXX USCH ,NUMBER OF SEARCHES DONE.................
}
DEFINE XXX(A,B) <
A: 0
>
LOCDAT: BLOCK 3 ;0)DSKTIM. 1)CPUTIM. 2)SRCTIM.
NAMES
0 ;extra word because of dump mode bug (losing 4 bits)
ULEN←←.-LOCDAT
TOTDAT: BLOCK ULEN
CPUTIM←←1
SRCTIM←←2
DEFINE XXX(A,B) <
[ASCIZ \B\]
>
MSGDAT←.-3
NAMES ;block of ptrs to ASCIZ strings for data in USE.DAT
;LOOKUP/ENTER blocks.
COMMENT ⊗ I/O CHANNELS USED
0:DICT
1:LINKS
2:INDEX
3:WORDS
4:NEWS
5:output file for news
6:new <pn>.DEL file for notification requests deleted
7:new <pn>.ADD file
10:input of NOTIF and old <pn>.ADD for displaying/stopping requests
12:input command file
13:tty (output from message file)
14:USERS
15:USE.DAT (input)
16:USE.DAT (output)
17:APMESS (message file) end of comment ⊗
NEWSF: SIXBIT /NEWS/
BLOCK 3
INDEXF: SIXBIT /INDEX/
BLOCK 3
LINKSF: SIXBIT /LINKS/
BLOCK 3
DICTF: SIXBIT /DICT/
BLOCK 3
WORDSF: SIXBIT /WORDS/
BLOCK 3
MESSF: SIXBIT /APMESS/
BLOCK 3
FILE: 0 ;ENTER block for file to which some news stories are
SIXBIT /AP/ ; to be outputted. Always given the extension .AP
BLOCK 2
NOTIFF: SIXBIT /NOTIF/ ;main automatic notification file
BLOCK 3
USEF: SIXBIT /USE2/ ;file containing APE usage data
SIXBIT /DAT/
BLOCK 2
USERSF: SIXBIT /USERS/ ;file containing programmer names of APE users
BLOCK 3
;Storage arrays, dump mode commands, OPEN blocks.
USERS: ;USERS and TMPBUF blocks are the same (common) to save space
TMPBUF: BLOCK 230
STORY: BLOCK STLEN ;block for holding text of a story in core
RQBUF←STORY+600 ;buffer used for notif requests
INDEX: BLOCK XLEN ;block for holding entire INDEX file
LINKS: BLOCK LLEN ;block for holding entire LINKS file
DICT: BLOCK DLEN ;block for holding entire DICT file
WORDS: BLOCK WLEN ;block for holding entire WORDS file
SORDID: BLOCK SLEN ;block of headers for story lists
PDLIST: BLOCK PDLEN ;area for push down list
STYLST: BLOCK SLSTLN ;block for pointers to the stories found
POLLEN←←40
POLISH: BLOCK POLLEN ;right polish for keyw expr--used with auto notif
MBUF: BLOCK 3 ;buffer header for input from APMESS and <pn>.ADD
TBUF: BLOCK 3 ;buffer header for output from APMESS and to <pn>.ADD
DIGITS: BLOCK 4
CMD: IOWD 1,STORY
0
XCMD: IOWD XLEN,INDEX
0
LCMD: IOWD LLEN,LINKS
0
UCMD: IOWD ULEN,TOTDAT ;command for writing out usage data
0
DCMD: IOWD DLEN,DICT
0
WCMD: IOWD WLEN,WORDS
0
FCMD: IOWD 1,STORY ;dump mode command for writing out selected stories
0 ; on a file
NCMD: IOWD 1,RQBUF
0
PCMD: IOWD 1,USERS
0
DSK17: 17 ;OPEN block for disk i/o in mode 17
SIXBIT /DSK/
0
MBUF10: 10 ;OPEN block for input with MBUF header in mode 10
SIXBIT /DSK/
MBUF
TBUF10: 10 ;OPEN block for output with TBUF header in mode 10
SIXBIT /DSK/
TBUF,,
;Special data words.
TOTAL: 0 ;count of the total number of stories found
FLBPTR: 0 ;byte ptr for storing sixbit filename in FILE
PPN: SIXBIT / APSYS/ ;ppn for all the AP system files
AVSLST: 0 ;ptr to first element in list of available STYLST slots
HEAD1: 0 ;ptr to first element in first story list in set operation
HEAD2: 0 ;ptr to first element in second story list in set operation
NFOUND: 0 ;total number of stories found in current story list
FSTNBR: 0 ;relative number of selected beginning story
SCDNBR: 0 ;relative number of selected ending story
HEADER: 0 ;header for the sublist of stories selected
SAVNBR: 0 ;place for saving in ASCII the nbr of stories found
NBRGON: 0 ;place for counting nbr of stories that have disappeared
LINEBP: 0 ;byte ptr into a command line typed in
BRCHAR: 0 ;char causing activation at end of typed in line
KSTART: 0 ;byte ptr to start of current keyword in keyword expr
POLPTR: 0
USRPPN: 0
RAPED: -1 ;counter of number of times user started APE
SEQBEG: 0 ;starting sequence number of group
SEQEND: 0 ;ending sequence number of group
STARS: ASCIZ /************************************************************
/
STARLN←←.-STARS
SMINUS: -1,,2
SPLUS: -1,,1
SSTAR: -1,,0
CRLF: ASCIZ/
/
CRLFS: ASCIZ/
/
MONTHS: FOR MON IN (Jan,Feb,Mar,Apr,May,June,July,Aug,Sept,Oct,Nov,Dec)
< ASCIZ \MON\
>
;Initialization.
APE: MOVE P,[IOWD PDLEN,PDLIST]
PUSHJ P,CLEARU
IFN ARPA,<
SETO A,
GETLIN A ;GET TTY CHARACTERISTICS
TLNE A,1000 ;IS THIS GUY ON THE ARPA NET?
OUTSTR [ASCIZ\
Remote users can get a current copy of the writeup for APE by
MAILing a message requesting it to 'ME'. Please give your name
and complete address.
\] ;YES
>;END IFN ARPA
SETZ A,
CALLI A,27 ;RUNTIM
MOVEM A,LOCDAT+CPUTIM ;save run time at start up of ape
CALLI 0 ;RESET world
MOVEI F,"@" ;clear all flags and put "@" byte into AC
MAXT←←=45
MOVEI B,MAXT ;max length of time we try to lookup DICT
OPNDCT: OPEN 0,DSK17 ;DICT file
UBIGERR 4 ; ;OPEN FAILED ON DSK
MOVE A,PPN
MOVEM A,DICTF+3
LOOKUP 0,DICTF
JRST [RELEAS 0,
CAIL B,MAXT
OUTSTR [ASCIZ /One moment please.../]
MOVEI A,1
CALLI A,31 ;SLEEP a sec
SOJGE B,OPNDCT
UBIGERR 10] ; ;could not LOOKUP DICT for MAXT secs
HLRE A,DICTF+3 ;get size of DICT
CAMGE A,[-DLEN]
UBIGERR 14 ; ;DICT IS TOO BIG TO FIT INTO ITS ARRAY
MOVNM A,DICLEN# ;save size of dictionary
HRLM A,DCMD ;put size into dump mode command for DICT
IN 0,DCMD
JRST .+2
UBIGERR 20 ; ;IN UUO FAILED TO READ IN DICT
OPEN 1,DSK17 ;LINKS file
UBIGERR 24 ; ;OPEN FAILED ON DSK
MOVE A,PPN
MOVEM A,LINKSF+3
LOOKUP 1,LINKSF
UBIGERR 30 ; ;LOOKUP FAILED ON LINKS
IN 1,LCMD
JRST .+2
UBIGERR 34 ; ;IN UUO FAILED TO READ IN LINKS
RELEAS 1,
;Initialization.
OPEN 2,DSK17 ;INDEX file
UBIGERR 40 ; ;OPEN FAILED ON DSK
MOVE A,PPN
MOVEM A,INDEXF+3
LOOKUP 2,INDEXF
UBIGERR 44 ; ;LOOKUP FAILED ON INDEX
IN 2,XCMD
JRST .+2
UBIGERR 50 ; ;IN UUO FAILED TO READ IN INDEX
RELEAS 2,
OPEN 3,DSK17 ;WORDS file
UBIGERR 54 ; ;OPEN FAILED ON DSK
MOVE A,PPN
MOVEM A,WORDSF+3
LOOKUP 3,WORDSF
UBIGERR 60 ; ;LOOKUP FAILED ON WORDS
IN 3,WCMD
JRST .+2
UBIGERR 64 ; ;IN UUO FAILED TO READ IN WORDS
RELEAS 3,
RELEAS 0, ;keep the DICT file open until all files have been read in
OPEN 17,MBUF10 ;type out the file APMESS if it exists
UBIGERR 70 ; ;CANT OPEN THE DSK
MOVE A,PPN
MOVEM A,MESSF+3
LOOKUP 17,MESSF ;is there a message file to be typed out?
JRST NOMESS ;no
OUTSTR CRLF
INIT 13,10
SIXBIT /TTY/
XWD TBUF,0
UBIGERR 74 ; ;CANT INIT THE TTY
UOUTBF 13,[2↔201]
;Type out APMESS file, if any.
PUSHJ P,GMSWD ;get first word of file
CAME A,[ASCII/COMME/];is it a TV file?
JRST SOSMES ;no
PUSHJ P,PMSWD
PUSHJ P,GMSWD
CAME A,[ASCII/NT ⊗ /]
JRST SOSMES ;not TV file
GETSTS 13,B
TRO B,20 ;INHIBIT SYSTEM WORD COUNT CALCULATION
SETSTS 13,(B)
FINDFF: PUSHJ P,GMSRC
LDB CHAR,[POINT 7,A,6];get first char of record
CAIE CHAR,FF ;FF marks end of TV directory page
JRST FINDFF
TLZ A,774000 ;zero out the FF
MOVEM A,@MBUF+1
NXREC: HRLZ B,MBUF
HRR B,TBUF
AOBJN B,.+1
MOVEI C,(B)
BLT B,200(C) ;move from DSK buffer to TTY buffer
HRRZS (C) ;zero out left half of word count word
OUTPUT 13, ;write out TTY buffer
PUSHJ P,GMSRC ;get next record of file
JRST NXREC
SOSMES: TRNN A,1 ;is this word an SOS line number?
JRST SOS1 ;no
PUSHJ P,GMSWD ;yes. ignore it and get next word from file
TLZ A,774000 ;zero out the tab following the line number
SOS1: PUSHJ P,PMSWD ;write out this word
PUSHJ P,GMSWD ;get next word from file
JRST SOSMES
PMSWD: SOSG TBUF+2 ;put word into TTY buffer
OUTPUT 13,
IDPB A,TBUF+1
POPJ P,
GMSWD: SOSG MBUF+2
GMSRC: IN 17, ;get next record (buffer) from message file
JRST [ILDB A,MBUF+1 ;get word from buffer
POPJ P,]
SUB P,[1,,1]
RELEAS 13, ;TTY
NOMESS: RELEAS 17, ;message file
PUSHJ P,SHRINK ;release any extra core accumulated
;Initialization.
MOVEI A,INTRPT
MOVEM A,JOBAPR ;set up address of interrupt module
HRLZI A,4 ;enable for interrupts on [ESC] I
CALLI A,400025 ;INTENB
MOVEI A,REENT
MOVEM A,JOBREN ;set up reentry address
AOSN RAPED ;add one to count of number of restarts
AOS URAPE ;bump "r ape" count first time only
SETZ A,
CALLI A,24 ;GETPPN
MOVEM A,USRPPN
HRRZ B,A
CAME A,PPN
CAIN B,' ME'
TROA F,GOD
NOSPEC: PUSHJ P,SAVPPN
;Start of main loop: asking for keywords. REESET RSTART APE1
OUTSTR [ASCIZ /
Type ? and RETURN at any time for help.
/]
; $
REESET: MOVE A,[XWD -SLSTLN+2,STYLST];clear the current story list and
HRRZM A,AVSLST ; return all words of STYLST array
ADDI A,1 ; to the available space list
HRRZM A,-1(A)
AOBJN A,.-1
SETZM -1(A) ;put null ptr at end of available list
SETZM SORDID ;clear ptr to current story list
SETZM HEADER ;clear header to current story sublist
RSTART: MOVE P,[IOWD PDLEN,PDLIST] ;reset the pdl pointer (eg, after errors)
APE1: INSKIP ;reset any printout stop (↑O)
JFCL
SETZ SOR, ;point to header of current story list
SETOM POLPTR ;set length of polish expression to zero
TDZ F,[TYPOUT!NOTIFY,,AUTOSC!FROMFL];clear some flags
OUTSTR [ASCIZ /
KEYWORD EXPRESSION: /] ;ask for keywords expression
TRNE F,AUTOCN
TRNN F,INFILE
JRST KEY5
PUSHJ P,RFAUTO
JRST APE1
JRST KEY6
KEY5: TRNN F,GOD!PPNDUN
PUSHJ P,SAVPPN ;put PPN in USERS file
TRNN F,GOD
PUSHJ P,PUTDAT ;record usage data
PUSHJ P,READ ;read in keyword expression
KEY1: MOVEI CHAR,LF
CAME CHAR,BRCHAR
JRST KEY2
OUTCHR [":"]
AOS UCONLF
MOVEI CHAR," "
DPB CHAR,B
PUSHJ P,READ1
JRST KEY1
;Check for various kinds of keyword expressions.
KEY2: PUSHJ P,GETCH ;get first char of expr into CHAR
CAIN CHAR,"?"
JRST TELLKY ;wants some help!!
CAIE CHAR,"@"
JRST KEY4
PUSHJ P,READFL
JRST APE1
KEY6: PUSHJ P,GETCH
TRNN F,INFILE
JUMPE CHAR,APE1
TRO F,FROMFL ;indicate expression read from command file
AOS UFLXP
KEY4: JUMPN CHAR,KEY3 ;is keyword expression null?
AOS UNULL ;yes
JRST APE2 ;CR. use current story list
KEY7: SKIPE A,JOBDDT ;DO WE HAVE DDT AROUND?
JRST (A) ;YES
OUTSTR [ASCIZ\NO DDT\]
JRST APE1
KEY3: CAIN CHAR,"+" ;does expression start with "+"?
JRST [PUSHJ P,PLUS ;yes. perform union with current story list
AOS UPLUS
JRST CHECK]
CAIN CHAR,"-" ;does expression start with "-"?
JRST [PUSHJ P,MINUS ;yes. perform set difference from current story list
AOS UMINUS
JRST CHECK]
CAIN CHAR,"*" ;does expression start with "*"?
JRST [PUSHJ P,INTER ;yes. perform intersection with current story list
PUSHJ P,TERM2
AOS USTAR
JRST CHECK]
CAIN CHAR,"$"
PUSHJ P,[TLO F,NOTIFY ;wants to be notified
JRST GETCH]
JUMPE CHAR,NOTEDP ;just $ means display notification requests
CAIN CHAR,"$" ;two $'s means display and allow deletion
JRST NOTEDL
CAIN CHAR,"!"
JRST KEY7 ;WANTS TO GO INTO DDT
PUSHJ P,TERM ;read in a whole keyword expression
AOS UEXPR
;Set up main story list and report nbr of stories found.
CHECK: JUMPE CHAR,.+2 ;zero means have processed whole expression
MEDERR (SYNTAX ERROR) ; ;there were some chars after the TERM
HRRE PT1,SORDID(SOR) ;get ptr to first element in final story list
JUMPGE PT1,APE2 ;is story list a list in LINKS?
MOVN PT1,PT1 ;yes. copy it into STYLST
HRRZ X1,LINKS+1(PT1) ; get index ptr to first story
MOVEI PT3,SORDID(SOR) ; set up in PT3 a ptr to prev list element
TLZ F,OP1FLG ; indicate operand 1 is a list in LINKS
SETZM HEAD1 ; indicate no lists to be returned to
SETZM HEAD2 ; available STYLST storage
PUSHJ P,COPY1 ; actually copy the list into STYLST
APE2:
JUMPE SOR,APE8 ;is old current story list being used?
SKIPE A,SORDID ;no. is it null?
PUSHJ P,RETLST ;no. return it to free storage
APE8: HRRZ PT3,SORDID(SOR) ;get ptr to first element in story list
HRRZM PT3,SORDID ;store it in header to current story list
SETZ B, ;initialize the count of stories to zero
JUMPE PT3,NOMORE ;check for null list
APE3: ADDI B,1 ;add 1 to count of stories
HRRZ PT3,(PT3) ;get ptr to next element in story list
JUMPN PT3,APE3 ;check if at end of list
NOMORE: MOVEM B,NFOUND ;save the number of stories found
TLNE F,NOTIFY ;notification requested?
PUSHJ P,NOTE ;yes. write request on file
SKIPG PT1,NFOUND
JRST NONE ;no stories found
MOVE B,[POINT 7,DIGITS]
SETZM DIGITS
PUSHJ P,NXTDG
MOVE A,DIGITS
MOVEM A,SAVNBR ;save ascii of count in case of error
JRST ASK
CONERR: OUTSTR [ASCIZ/CONTRADICTORY SELECTIONS/]
ASKERR: PUSHJ P,PTREST
ASKER1: TRZ F,FROMFL!AUTOCN ;accept only one selection line from file
ASK: OUTSTR SAVNBR ;type out the number
OUTSTR [ASCIZ / news item(s) found. Selection: /]
TLZ F,TYPOUT!ORDER!MINUS1!MINUS2!PAIR!SEL!SELNUN!KEYS;clear flags
MOVE A,NFOUND
MOVEM A,FSTNBR ;pretend user has choosen all stories
TRC F,INFILE!CON!FROMFL
TRCE F,INFILE!CON!FROMFL
JRST ASK2
PUSHJ P,RFCON
JRST ASKER1
AOS UFLSL
JRST ASK3
;Read in story selection line.
ASK2: PUSHJ P,READ ;read in whole line
ASK3: ILDB CHAR,LINEBP ;see if there is a file name specified?
CAIN CHAR,"?"
JRST TELLSL
CAIE CHAR,"←"
JUMPN CHAR,ASK3
MOVE A,[POINT 7,TMPBUF]
MOVEM A,LINEBP
CAIE CHAR,"←" ;is there a file name specified?
JRST ASK1 ;no
MOVE A,[POINT 6,FILE] ;yes. put it into LOOKUP/ENTER block
MOVEI B,6
SETZM FILE
TLZ F,XTND!REPL
PUSHJ P,GETCH
GFL1: CAIN CHAR,"←"
JRST GFL9
CAIN CHAR,"."
JRST GFL8
CAIN CHAR,"["
JRST GFL7
CAIN CHAR,"/"
JRST FLSWCH
CAIG CHAR,40
JRST GFL6
SOJL B,GFL5
TRZ CHAR,40 ;convert file name char to sixbit
TRZE CHAR,100
TRO CHAR,40
IDPB CHAR,A ;save file name char
ILDB CHAR,LINEBP
JRST GFL1
GFL5: OUTSTR [ASCIZ/FILE NAME TOO LONG/]
JRST ASKERR
GFL6: OUTSTR [ASCIZ/ILLEGAL CHAR IN FILE NAME/]
JRST ASKERR
GFL7: OUTSTR [ASCIZ/PPN NOT ALLOWED/]
JRST ASKERR
GFL8: OUTSTR [ASCIZ/FILE NAME EXTENSION NOT ALLOWED/]
JRST ASKERR
FLSWCH: PUSHJ P,GETCH ;read in file switch
CAIE CHAR,"Q"
CAIN CHAR,"q"
JRST SETRPL ;wants to replace old file of same name
CAIE CHAR,"X"
CAIN CHAR,"x"
JRST SETXTD ;wants to extend old file
JRST SWERR
SETRPL: TLOA F,REPL
SETXTD: TLO F,XTND
PUSHJ P,GETCH
CAIN CHAR,"←" ;switch must be last part of file spec
JRST GFL9
SWERR: OUTSTR [ASCIZ/ILLEGAL FILE SWITCH/]
JRST ASKERR
GFL9: SKIPE FILE
JRST GFL10
OUTSTR [ASCIZ/NULL FILE NAME ILLEGAL/]
JRST ASKERR
GFL10: TLO F,SAVFIL
;Process rest of selection line.
CONTRA← DONT!FEW!CHOOSE!LSTFEW!SELNUN!SPOOL!SAVFIL;more or less contradictory flags
ASK1: PUSHJ P,GETCH ;get next char of line
WHICH0: JUMPE CHAR,CLUNK ;zero means have found end of selection line
CAIE CHAR,"F"
CAIN CHAR,"f"
JRST [TLO F,FEW ;wants only the First few lines of each story
TLNE F,CONTRA-(FEW!LSTFEW)
JRST CONERR
JRST ASK1]
CAIE CHAR,"C"
CAIN CHAR,"c"
JRST [TLO F,CHOOSE ;wants to Choose which stories he reads
TLNE F,CONTRA-(CHOOSE!SPOOL!SAVFIL)
JRST CONERR
JRST ASK1]
CAIE CHAR,"L"
CAIN CHAR,"l"
JRST [TLO F,LSTFEW ;wants only the Last few lines of each story
TLNE F,CONTRA-(LSTFEW!FEW)
JRST CONERR
JRST ASK1]
CAIE CHAR,"N"
CAIN CHAR,"n"
JRST [TLO F,SELNUN ;doesn't want to see any of the stories
TLNE F,(SEL!CONTRA)-(SELNUN!DONT)
JRST CONERR
JRST ASK1]
CAIE CHAR,"S"
CAIN CHAR,"s"
JRST [TLO F,SPOOL ;wants stories selected to be spooled
TLNE F,CONTRA-(SPOOL!CHOOSE!DONT!SAVFIL)
JRST CONERR
JRST ASK1]
CAIE CHAR,"W"
CAIN CHAR,"w"
JRST [TLO F,KEYS ;wants list of keywords for each story
JRST ASK1]
CAIE CHAR,"D"
CAIN CHAR,"d"
JRST [TLO F,DONT ;doesn't want stories typed out
TLNE F,CONTRA-(DONT!SPOOL!SAVFIL!SELNUN)
JRST CONERR
JRST ASK1]
CAIE CHAR,"K"
CAIN CHAR,"k"
JRST [TRZ F,AUTOCN ;wants to discontinue automatic reading
JRST ASK1] ; from command file
CAIN CHAR,"?"
JRST TELLSL ;wants some help!
;Read in story selection numbers and build up sublist of selected stories.
WHICH2: CAIE CHAR,"=" ;does he want the order of the stories reversed?
JRST WHICH1 ;no
TLC F,ORDER ;yes
JRST ASK1
WHICH1: TLOE F,SEL ;has he already made a story selection?
JRST SELERR ;yes. some unknown stuff in selection line
CAIE CHAR,"-"
JRST WHICH3
TLO F,MINUS1 ;set flag to indicate that 1st story nbr was negative
PUSHJ P,GETCH
WHICH3: PUSHJ P,GETSTY
JUMPE B,SELERR
CAMLE B,NFOUND ;has a nonexistent story been selected?
JRST NONEXS
MOVEM B,FSTNBR
CAIE CHAR,":"
JRST WHICH0
TLO F,PAIR ;set flag to indicate that a pair of nbrs were typed in
PUSHJ P,GETCH
CAIE CHAR,"-"
JRST WHICH7
TLO F,MINUS2 ;set flag to indicate that 2nd story nbr was negative
PUSHJ P,GETCH
WHICH7: PUSHJ P,GETSTY
JUMPE B,SELERR
CAMLE B,NFOUND
JRST NONEXS
MOVEM B,SCDNBR
JRST WHICH0
NONEXS: OUTSTR [ASCIZ /STORY NUMBER TOO BIG: /]
MOVE PT1,B
PUSHJ P,PRNTNO
OUTSTR CRLF
JRST ASKER1
SELERR: OUTSTR [ASCIZ/SELECTION ERROR/]
JRST ASKERR
;Build up a list of the stories selected.
CLUNK: TLNE F,SELNUN ;has he selected none of the stories?
JRST APE1 ;yup. give him what he wants
TLNE F,DONT
TLNE F,SAVFIL!SPOOL!KEYS
JRST .+2
JRST APE1 ;dont type, file, or spool!!
TLNE F,PAIR ;were a pair of story numbers typed in?
JRST HAVEPR ;yes
TLNE F,MINUS1 ;no. did the story number have a minus sign?
JRST GETOLD ;yes
MOVEI A,1 ;no. select the most recent FSTNBR stories
EXCH A,FSTNBR
MOVEM A,SCDNBR ;end with story number FSTNBR
JRST BUILD
GETOLD: MOVE A,NFOUND
MOVEM A,SCDNBR ;end with last story
SUB A,FSTNBR ;calculate the number of the FSTNBR oldest story
ADDI A,1
MOVEM A,FSTNBR ;store number of starting story
JRST BUILD
HAVEPR: TLNN F,MINUS1 ;did the first story number have a minus sign?
JRST CHK2ND ;no. see if the 2nd story did.
MOVE A,NFOUND ;yes
SUB A,FSTNBR ;calculate the number of the FSTNBR oldest story
ADDI A,1
MOVEM A,FSTNBR ;store number of starting story
CHK2ND: TLNN F,MINUS2 ;did the second story number have a minus sign?
JRST BUILD ;no
MOVE A,NFOUND ;yes
SUB A,SCDNBR ;calculate the number of the SCDNBR oldest story
ADDI A,1
MOVEM A,SCDNBR ;store number of ending story
;Finish building up story sublist.
BUILD: SKIPE A,HEADER ;is there a non-null sublist sitting around?
PUSHJ P,RETLST ;yes. return it to free storage
SETZM HEADER
GRONK: MOVE A,FSTNBR ;load numbers of beginning and ending stories and
MOVE B,SCDNBR ; build up sublist of those stories
CAMG A,B ;are oldest stories to come first?
JRST BUILD1 ;no
EXCH A,B ;put number of lowest numbered story into A
TLC F,ORDER ;set flag indicating the list built up should be in rev order
BUILD1: SUBI B,-1(A) ;put number of stories to be collected into B
HRRZ PT1,SORDID(SOR) ;get ptr to first element of whole list
BUILD2: MOVE PT1,(PT1) ;get the next element of the whole list
SOJG A,BUILD2 ;have we reached the first story for the sublist?
TLNE F,ORDER ;yes. should the stories be collected in reverse order?
JRST BLDREV ;yes
MOVEI PT3,HEADER ;get ptr to the header for the sublist
BUILD3: PUSHJ P,GETAVL ;put this story into the sublist
HLLM PT1,(PT3) ;put the index of this story into the sublist element
MOVE PT1,(PT1) ;get the next element of the whole list
SOJG B,BUILD3 ;have we collected the necessary number of stories?
HLLZS (PT3) ;yes. put null ptr at end of sublist
HRRZ PT3,HEADER ;load PT3 with ptr to first element of sublist
JRST DOESHE
BLDREV: SETZ PT3, ;make ptr to current sublist element null
REV3: SKIPN STYPTR,AVSLST ;get available word for reversed story list
JRST NUNAVL ;there are no available words for the story list!
MOVE A,(STYPTR) ;get ptr to 2nd available word and store it
MOVEM A,AVSLST ; in header of available list
HRRZM PT3,(STYPTR) ;put ptr to prev list element in new list element
MOVE PT3,STYPTR ;put ptr to new element into PT3
HLLM PT1,(PT3) ;put the index of this story into the sublist element
MOVE PT1,(PT1) ;get the next element of the whole list
SOJG B,REV3 ;have we collected the necessary number of stories?
HRRZM PT3,HEADER ;store ptr to the sublist for returning it to avail storage
DOESHE: TLNN F,SAVFIL!SPOOL ;is there to be an output file???
JRST TYPEM ;no
DIR2: TLNE F,SAVFIL ;does he want the news saved in a file?
JRST DIR5 ;yes. go lookup/enter file
MOVE A,[SIXBIT /$NEWS0/];initialize name for file to be spooled
DIR9: MOVEM A,FILE ;put file name in LOOKUP/ENTER block
MOVE B,USRPPN
MOVEM B,FILE+3 ;put file to be spooled on user's real disk area
OPEN 5,DSK17
UBIGERR 110 ; ;OPEN FAILED ON DSK
LOOKUP 5,FILE ;does file already exist?
JRST DIR6 ;no. go do an ENTER on it
RELEAS 5, ;yes. increment special name and try again
AOJA A,DIR9
;LOOKUP output file to see if it already exists, then ENTER it.
DIR5: OPEN 5,DSK17 ;see if file specified already exists.
UBIGERR 100 ; ;OPEN FAILED ON DSK
SETZM FILE+3 ;file will be on the users area
TLNN F,REPL
LOOKUP 5,FILE
JRST DIR6 ;file doesn't exist or should be replaced. ENTER it
TLNE F,XTND
JRST EXTEND
OUTSTR [ASCIZ /FILE ALREADY EXISTS!
Type Q to replace, X to extend, or just <return> for new selection line: /]
PUSHJ P,READ
PUSHJ P,GETCH
CAIE CHAR,"Q"
CAIN CHAR,"q"
JRST DIR6 ;replace specified file
CAIE CHAR,"X"
CAIN CHAR,"x"
JRST EXTEND ;extend specified file
RELEAS 5,
CAIN CHAR,"?"
FLQUES: OUTSTR [ASCIZ $
Follow the filename with /Q to have any old file of same name replaced
with a file containing the currently selected stories.
Follow the filename with /X to have any old file of same name extended
by adding the currently selected stories at the end of the old file.
$]
JRST ASKER1 ;ask for another selection line
;Enter file for saving/spooling stories.
DIR6: RELEAS 5,
OPEN 5,DSK17 ;do an ENTER on the output file for the news
UBIGERR 104 ; ;OPEN FAILED ON DSK
EXTEND: HLLZS FILE+1 ;file gets standard extension .AP
MOVSI B,400000 ;protection will be 400 (dump never)
MOVEM B,FILE+2
SETZM FILE+3 ;put file on user's disk area
MOVE B,USRPPN
TLNN F,SAVFIL ;is this file to be saved?
MOVEM B,FILE+3 ;no. put it on disk area of user's logged in ppn
ENTER 5,FILE
JRST DIR14 ;ENTER failed
UGETF 5,B ;set file ptr to end of file
JRST TYPEM ;ENTER succeeded
DIR14: RELEAS 5,
TLNN F,SAVFIL ;was the ENTER for a file only to be spooled?
AOJA A,DIR9 ;yes. increment the name of the special spooling file
OUTSTR [ASCIZ /
ENTER failed on output file!
/] ;no. tell user that the ENTER failed on the file name he gave
JRST ASKER1 ;go ask for another file name
;Read in the stories found: TYPEM
TYPEM: OUTSTR CRLFS
TLNN F,KEYS
TLNN F,DONT ;type out row of stars before first story if typing
OUTSTR STARS
SETZM AMT# ;indicate nothing in overflow buffer
SETZM NBRGON ;zero out the counter of stories gone
SETZM INTFG ;clear [ESC] I flag
NXTSTY: HLRZ X,(PT3) ;get index of current story in story list
TLNE F,KEYS ;does he want to see keywords for this story?
PUSHJ P,TYKEYS ;yes. type them out
EXTRA: PUSHJ P,READIT ;read in the story
JRST [HRRE X,INDEX(X);story not found in NEWS
JUMPG X,EXTRA ;does story have a follow up?
AOS NBRGON ;no. count nbr of stories completely gone
JRST GETNXT] ;go on to next story
SKIPE INTFG
JRST ESCI
TLNN F,FEW ;does he want only first few lines of each story?
JRST TYP7 ;no
AOS UFEW
TLNE F,LSTFEW ;does he also want the last few lines?
JRST TYP5 ;yes
MOVE A,CRLFS ;no. type out only the first few lines
MOVEM A,=50(DISPL) ;print only first =50 words (=250 chars)
OUTSTR (DISPL) ;type out the first few lines
JRST TYP8
TYP5: MOVEI B,=80 ;type out only the first few and the last few lines
CAML B,TOTSIZ
JRST TYP4 ;small story. type out whole thing
MOVE A,CRLFS
MOVEM A,=50(DISPL)
OUTSTR (DISPL)
JRST TYP10
;Allow choosing stories. TYP7 TYP14 TYP10
TYP7: TLNN F,CHOOSE ;does he want to choose which stories get typed out?
JRST TYP14 ;no
INSKIP ;reset ↑O
JFCL
AOS UCHSF
ECHOFF ;turn off echoing for choose response
SETZ A,
EXCH A,=50(DISPL)
OUTSTR (DISPL) ;type out first part of story
SKIPE INTFG
JRST CINT
INCHWL CHAR ;see what user wants to do now
ECHON ;turn echoing back on
CLRBFI
CAIN CHAR,CR ;just <CRLF> means dont type out rest of story
JRST [OUTSTR CRLFS↔JRST TYP18]
CAIE CHAR,"I" ; I <CRLF> means give up this fruitless process
CAIN CHAR,"i"
JRST CINT
AOS UCHS
MOVEM A,=50(DISPL) ;anything else means type out rest of story
MOVEI B,=50
CAMGE B,TOTSIZ
OUTSTR =50(DISPL) ;type out remainder
JRST TYP15
TYP14: TLNN F,LSTFEW ;does he want only the last few lines of each story?
JRST TYP6 ;no
TYP10: MOVEI A,STORY-=25 ;yes. compute ptr to =25 words before end of story
SUB A,SIZE
CAMGE A,DISPL ;is this ptr in middle of story?
TYP4: MOVE A,DISPL ;no. must be a very short story. type it all out.
OUTSTR (A)
AOS ULST
JRST TYP8
TYP6: TLNE F,DONT ;does user want the story typed out?
JRST TYP15 ;no
OUTSTR (DISPL) ;type out the story
AOS UTYP
TYP15: TLNN F,SAVFIL+SPOOL ;is there an output file?
JRST TYPE1 ;no
;Put story into output file. TYP9 TYPE1
TYP9: MOVE A,AMT ;get number of words left over last time
MOVE B,TOTSIZ ;get total size of current story
ADD B,A ;amount that now needs to be output
MOVE D,B
ANDI D,177 ;amount that will be left over this time
MOVEM D,AMT ;save this nbr for next time
ANDI B,777600 ;amount that will be output now (multiple of 200)
JUMPE B,FIL6 ;any stuff going out now?
MOVN D,B ;yes
JUMPN A,FIL2 ;was there any stuff left over from before?
HRLI D,-1(DISPL) ;no. output from beginning of story
JRST FIL3
FIL2: MOVSI C,(DISPL) ;move main part of story up to end of
HRRI C,TMPBUF(A) ; left over stuff
BLT C,TMPBUF-1(B)
HRLI D,TMPBUF-1 ;output from beginning of left over stuff
FIL3: MOVSM D,FCMD
OUT 5,FCMD ;write out the story on the output file
JRST .+2
UBIGERR 114 ; ;OUT UUO FAILED TO WRITE OUT A STORY ON A FILE
ADD DISPL,B
SUB DISPL,A
SETZ A, ;stuff left over from last time is now gone
FIL6: HRLZ DISPL,DISPL ;move new left over stuff to save it for next time
HRRI DISPL,TMPBUF(A)
SKIPE C,AMT ;if no left over stuff, no use moving it
BLT DISPL,TMPBUF-1(C)
TLNE F,SAVFIL
AOS UFIL ;increment number of stories filed
TLNE F,SPOOL
AOS USPL ;increment number of stories spooled
;Get follow-up story if any, else get next story. Finish up.
TYPE1: HRRE X,INDEX(X) ;is this story linked up with a follow-up
JUMPG X,EXTRA ; story of some kind?
TLNE F,DONT ;no. is the news being typed out?
TLNE F,KEYS
JRST TYP8
OUTCHR ["@"] ;no. type out an "@" for each story writen on the file
TYP8: TLNN F,SAVFIL+SPOOL ;are the stories are being filed?
JRST TYP18 ;no
MOVE A,AMT ;yes. put a row of *'s in the file
MOVSI B,STARS
HRRI B,TMPBUF(A)
BLT B,TMPBUF+STARLN-1(A);move *'s into overflow buffer
ADDI A,STARLN
MOVEM A,AMT
;Get next story in list. TYP18 GETNXT DIR8
TYP18: INSKIP ;reset typeout flag in case user typed ↑O
JFCL
SKIPE INTFG
JRST ESCI
TLNN F,KEYS
TLNN F,DONT ;if the news is being typed out, separate stories
OUTSTR STARS ; with a row of *'s
GETNXT: HRRZ PT3,(PT3) ;get ptr to next element in story list
JUMPN PT3,NXTSTY ;if not at end of list, go back and process next story
SKIPE INTFG
JRST ESCI
SKIPN PT1,NBRGON
JRST DIR8
PUSHJ P,PRNTNO
OUTSTR [ASCIZ / OF THE STORIES WENT AWAY--SORRY
/]
DIR8: TLNE F,DONT ;the stories have now been outputted
OUTSTR CRLF ; as requested
TLNN F,SPOOL+SAVFIL ;is there an output file?
JRST APE1 ;no. nothing left to do
MOVN A,AMT ;yes. finish writing out file
JUMPE A,FIL4
HRLI A,TMPBUF-1 ;set up dump mode command to output overflow buffer
MOVSM A,FCMD
OUT 5,FCMD
JRST .+2
UBIGERR 120 ; ;OUT UUO FAILED TO OUTPUT OVERFLOW BUFFER
FIL4: RELEAS 5,
TLNN F,SPOOL ;is the file to be spooled?
JRST APE1 ;no
HLLZS FILE+1 ;yes. zero the spooler flags
SETZM FILE+3 ;use user's current disk ppn
TLNE F,SAVFIL ;should the file be deleted after spooling?
JRST FIL4B ;no
MOVEI A,1 ;yes
HRRM A,FILE+1 ;set the delete flag for spooler
MOVE A,USRPPN ;the spool file to be deleted is on disk area of
MOVEM A,FILE+3 ; the user's logged in ppn
FIL4B: PUSHJ P,SPOOLM ;spool the file
JUMP FILE ;ptr to data block for spooler
JRST APE1 ;go back and get next set of keywords
;TERM MINUS PLUS FACTOR PRIMAR INTRPT CINT ESCI
TERM: PUSHJ P,FACTOR ;term ::= factor { [+|-] factor }
TERM2: CAIN CHAR,"+" ; where [...] means choose one of ..., and
JRST PLUS ; where {...} means ... may occur zero or more times
CAIE CHAR,"-"
POPJ P,
MINUS: PUSHJ P,SDIFF ;take the set difference of the two factors separated by -
PUSHJ P,SAVPOL
SMINUS
JRST TERM2 ;look for more +'s or -'s
PLUS: PUSHJ P,UNION ;take the union of the two factors separated by +
PUSHJ P,SAVPOL
SPLUS
JRST TERM2 ;look for more +'s or -'s
FACTOR: PUSHJ P,PRIMAR ;factor ::= primary { * factor }
FACT2: CAIE CHAR,"*" ; note: factors are intersected from right to
POPJ P, ; left since in this case that's equivalent to left to right
PUSHJ P,INTER ;take the intersection of the primary and factor separated by *
PUSHJ P,SAVPOL
SSTAR
JRST FACT2
PRIMAR: CAIE CHAR,"(" ;primary ::= keyword | ( term )
JRST GETWD ;no "(". get a keyword.
PUSHJ P,GETCH ;found "(". get next char.
PUSHJ P,TERM ;get term following "("
CAIN CHAR,")" ;check for ")" after term
JRST GETCH ;found ")". get next char and return from PRIMAR
MEDERR (MISSING RIGHT PARENTHESIS) ; ;
INTRPT: SETOM INTFG# ;so he typed [ESC] I, did he...
SETZM STORY ;zero out any story in core to stop an outstr
MOVE A,[XWD STORY,STORY+1]
BLT A,STORY+STLEN-1
CLRBFO
CALLI 400024 ;DISMIS
CINT: ECHON ;make sure echoing is on!
ESCI: OUTSTR [ASCIZ /
↑I
/] ;user typed [ESC] I while typing out stories
CLRBFI ;CANT TYPE AHEAD WITH [ESC] I
RELEAS 4, ;let go of NEWS file!
RELEAS 5,3 ;throw away output file if open
TRZ F,AUTOCN ;disable automatic reading from command file
JRST RSTART
;GETWD
GETWD: SETZM ORIGHD
ADDI SOR,1 ;make new entry in SORDID for story list for this keyword
CAIL SOR,SLEN
MEDERR (Too many keywords)
CAIN CHAR,"." ;does this keyword specify the latest news?
JRST LATEST ;yes
CAIN CHAR,"#" ;does this "keyword" specify a certain seq nbr?
JRST SEQNBR ;yes. collect all stories with given seq nbr
MOVE A,LINEBP
MOVEM A,KSTART ;save byte ptr to current keyword
PUSHJ P,READWD
CKNULL: CAMN PT1,[NULL: ASCII /@@@@@/];is the word null (has no characters)?
MEDERR (MISSING KEYWORD) ; ;
SETZ DICTWD, ;initialize ptr to just before 1st word in dictionary
NXTDWD: ADDI DICTWD,2 ;advance DICTWD ptr to the next word in the dictionary
HLRZ FIRST,DICT(DICTWD) ;get ptr to the text of the dictionary word
MOVE A,B ;move length of typed-in keyword into A
;compare the typed-in keyword with the dictionary word
CAME PT1,WORDS(FIRST) ;method of comparison: compare 5 chars at a time
JRST CK1 ; until either the two words differ or
AOJGE A,FOUND ; the end of the typed-in keyword is
CAME PT2,WORDS+1(FIRST) ; reached. If the two words differ, check
JRST CK2 ; which comes first alphabetically. If the
AOJGE A,FOUND ; dictionary word comes first, go back and
CAME PT3,WORDS+2(FIRST) ; get the next dictionary word. If the
JRST CK3 ; typed-in word comes first, then it
AOJGE A,FOUND ; isn't in the dictionary.
CAMN PT4,WORDS+3(FIRST)
JRST FOUND
CK4: CAMG PT4,WORDS+3(FIRST)
JRST NOTFND ;typed-in word not in the dictionary
JRST NXTDWD ;get the next dictionary word
CK3: CAMG PT3,WORDS+2(FIRST)
JRST NOTFND
JRST NXTDWD
CK2: CAMG PT2,WORDS+1(FIRST)
JRST NOTFND
JRST NXTDWD
CK1: CAMG PT1,WORDS(FIRST)
JRST NOTFND
JRST NXTDWD
;FOUND FINWD SAVPOL
FOUND: PUSHJ P,GETCH1
PUSHJ P,READWD
CAMN PT1,NULL
JRST FINWD
HLRZ DICTWD,DICT+1(DICTWD)
NXBRO: JUMPE DICTWD,NOMULT ; 0 means user wants mult key, but there is none
HLRZ FIRST,DICT(DICTWD)
MOVE A,B
CAME PT1,WORDS(FIRST)
JRST GETBRO
AOJGE A,FOUND
CAME PT2,WORDS+1(FIRST)
JRST GETBRO
AOJGE A,FOUND
CAME PT3,WORDS+2(FIRST)
JRST GETBRO
AOJGE A,FOUND
CAMN PT4,WORDS+3(FIRST)
JRST FOUND
GETBRO: HRRZ DICTWD,DICT+2(DICTWD)
JRST NXBRO
FINWD: HRRZ A,DICT+1(DICTWD) ;get ptr to first LINKS slot for this word
CAIN A,-1
JRST NOMULT
MOVN A,A
HRRM A,SORDID(SOR) ; and store it negated with this keyword
PUSHJ P,SAVPOL
DICTWD
JRST GETCH1 ;skip any special chars after keyword (blanks, CR's, LF's, tabs
SAVPOL: TLNN F,NOTIFY ;is this a notif request?
JRST CPOPJ1 ;no
PUSH P,A ;yes. save a couple of ACs
PUSH P,B
AOS A,POLPTR
CAIL A,POLLEN ;have we overflowed array for polish expr?
JRST SAVPL2 ;YES. DISABLE THE REQUEST
MOVE B,@-2(P)
MOVE B,(B)
MOVEM B,POLISH(A)
SAVPL1: POP P,B ;restore the ACs and take skip return ALWAYS
POP P,A
AOS (P)
POPJ P,
SAVPL2: TLZ F,NOTIFY
OUTSTR [ASCIZ \EXPRESSION TOO LONG FOR NOTIFICATION.
\]
JRST SAVPL1
;NONE NOTFND NOMULT ASKSRC
NONE: OUTSTR [ASCIZ /NO NEWS ITEMS FOUND/] ;keywords had no associated news stories
JRST APE1
NOTFND: CAME PT1,[ASCII /FOO@@/]
JRST NOT1
PUSHJ P,PRINTU ;print out usage data
JRST RSTART
NOT1: CAMN PT1,[ASCII /BAZ@@/]
TRNN F,GOD
JRST NOMULT
PUSHJ P,PRINTU ;print out usage data
PUSHJ P,ZEROUS ; and then zero it
JRST RSTART
NOMULT: PUSHJ P,GETCH1 ;get next nonblank char
PUSHJ P,READWD ;get rest of mult word keyword, if any
CAME PT1,NULL ;if null, no more mult sub words
JRST NOMULT
AOS A,POLPTR ;move text of unrec keyw into a buffer so
CAIL A,POLLEN ; that we can outstr it and search for it
HALT . ; ;
ADDI A,POLISH ;make byte pointer into the POLISH block
HRLI A,700
MOVEM A,TMPBP#
MOVEM A,FSTBP# ;save byte pointer to beginning of string
MOVE B,KSTART ;get byte pointer to beginning of keyword
LDB A,B ;get first char of keyword
JRST .+2
ILDB A,B ;get next char of keyword
IDPB A,TMPBP ; and save it in string in POLISH block
CAME B,LINEBP ;got last char of keyword?
JRST .-3 ;no. get another
SETZ A, ;yes. put a null byte after string
DPB A,TMPBP
TRNE F,GOD ;ONLY GOD CAN MAKE A (SEARCH) TREE
JRST ASKSRC
TLZE F,NOTIFY ;DONT ALLOW NOTIFICATION REQUESTS TO SEARCH
OUTSTR [ASCIZ\Searching in notification requests not yet implemented.
\]
ASKSRC: OUTSTR [ASCIZ /Unrecognized keyword: /]
HRRZ A,FSTBP
OUTSTR 1(A) ;type out the unrec keyword
TROE F,AUTOSC ;should we search without asking?
JRST LOOK0 ;yes
OUTSTR [ASCIZ /. Search? /] ;no. ask if we should search
PUSHJ P,READY ;read in the answer
JRST LOOK ;"Y"
JRST TELLSC ;"?". wants some help.
NOM1: AOS UUNREC ;any other char means no search
JRST RSTART ;give up on this keyw expr
;READWD
READWD: SETZ PT1,
SETZ PT2,
SETZ PT3,
SETZ PT4,
MOVEI B,=20 ;limit the number of chars in keyword to 20
MOVE TXTPTR,[POINT 7,PT1] ;initialize byte ptr to deposit chars in ACs PT1-4
NXTCHR: CAIL CHAR,"a" ;is current char a small letter?(less than"a"?)
CAILE CHAR,"z" ;maybe. Is it less than than "z"?
JRST NOTSML ;not a small letter
TRZ CHAR,40 ;was a small letter. turn off 40 bit making it a cap letter
JRST GOTLTR
NOTSML: CAIL CHAR,"0" ;is this char eligible to be in a keyword?
CAILE CHAR,"Z"
JRST RWD1 ;no. must be end of keyword
CAILE CHAR,"9" ;maybe. does it come between "9" and "A"?
CAIL CHAR,"A"
JRST GOTLTR ;no. must be a letter or a digit
JRST RWD1 ;yes. end of keyword
GOTLTR: SOJL B,.+2 ;it is a letter. has keyword already got 20 chars in it?
IDPB CHAR,TXTPTR ;no. put current char in TEXT
ILDB CHAR,LINEBP ;get the next character
JRST NXTCHR
RWD1: JUMPG B,DEP100
HRREI B,-4 ;put negated number of ACs holding keyword into B
POPJ P,
DEP100: IDPB F,TXTPTR ;deposit an "@" at end of keyword in PTs
SUBI B,1
TLNE TXTPTR,760000 ;byte ptr now pointing to low order byte in word?
JRST DEP100 ;no. go deposit another "@"
IDIVI B,5 ;calculate negated number of ACs holding keyword
SUBI B,4
POPJ P,
;READ READY GETCH
READ: MOVE B,[POINT 7,TMPBUF];read in a line typed by the user
MOVEM B,LINEBP ;initialize byte ptr to beginning of line
READ1: INCHWL CHAR
CAIN CHAR,CR
JRST READ4
CAIN CHAR,LF
JRST READ3
CAIN CHAR,ALT
JRST READ2
IDPB CHAR,B ;save the char
TRNN CHAR,600 ;is it an activation char?
JRST READ1 ;no. get next char
READ2: OUTSTR CRLF ;echo a CRLF when user types ALT or char with
JRST READ5 ; control bits on
READ3: OUTCHR [CR] ;echo a CR when user types LF
JRST READ5
READ4: INCHWL C ;read the LF of a user-typed CRLF
READ5: MOVEM CHAR,BRCHAR ;save the activation character
SETZ CHAR, ;place a zero byte after text string
IDPB CHAR,B
POPJ P,
;read in answer to yes/no question
READY: PUSH P,CHAR ;save CHAR
PUSH P,BRCHAR ;and BRCHAR
PUSH P,B ;and B
MOVE B,[POINT 7,STORY]
PUSHJ P,READ1
POP P,B
POP P,BRCHAR ;restore 'em
POP P,CHAR
LDB A,[POINT 7,STORY,6]
CAIE A,"Y"
CAIN A,"y"
POPJ P, ;direct return if answer is Yes
AOS (P) ;skip return otherwise
CAIE A,"?"
AOS (P) ;double skip return unless "?"
POPJ P,
GETCH: ILDB CHAR,LINEBP ;subroutine to put into CHAR the next char from
GETCH1: CAIE CHAR," " ; the keyword expression that is not
CAIN CHAR,TAB ; a space or a tab.
JRST GETCH
POPJ P,
;GETAVL NUNAVL GTORIG REENT
GETAVL: MOVE STYPTR,AVSLST ;get available word for story list
JUMPN STYPTR,.+2
NUNAVL: LGEERR {STORY LIST SPACE EXCEEDED! (TEMPORARY LISTS EXCEED 750 STORIES)} ; ;
MOVE A,(STYPTR) ;get ptr to 2nd available word and store it
MOVEM A,AVSLST ; in header of available list
HRRM STYPTR,(PT3) ;link up last element to this new element
MOVE PT3,STYPTR ;leave ptr to new element in PT3
POPJ P,
GTORIG: HLRZ X2,INDEX+2(X) ;is this story a follow up of another?
JUMPN X2,GTORG2
MOVEI C,ORIGHD ;no. see if this story already on orig list
JRST GT0
GT1: HLRZ X1,(D) ;get index ptr of this list element
CAMN X,X1 ;is it the same story?
JRST CPOPJ1 ;yes. nothing to do but skip
MOVE C,D ;no. move down list
GT0: HRRZ D,(C) ;get ptr to next element in list
JUMPN D,GT1 ;are we at end of orig list
PUSHJ P,GETAVL ;yes. put this story at end of main list
HRLM X,(PT3)
POPJ P,
GTORG2: MOVEI C,ORIGHD ;here we have the orig story of a follow up
JRST GTORG0 ; and we want to add story to orig list
GTORG1: HLRZ X1,(D) ;get index ptr of this list element
CAMN X2,X1 ;is this the same story?
JRST CPOPJ1 ;yes. dont have to do anything. skip return
MOVE C,D ;move down list
GTORG0: HRRZ D,(C) ;get ptr to next element in list
JUMPN D,GTORG1 ;are we at end of list?
GTORG4: EXCH C,PT3 ;yes
PUSHJ P,GETAVL ;add this story at end of originals list
HRLZM X2,(PT3)
MOVE PT3,C ;restore PT3
POPJ P,
REENT: RESET ;LET GO OF ANY FILES UPON REENTRY
MOVSI A,4 ;re-enable for interrupts on [ESC] I
INTENB A,
TRZ F,INFILE!CON!AUTOCN ;NO COMMAND FILE OPEN ANY MORE
JRST RSTART
;ADORIG RETLST
ADORIG: MOVEI C,ORIGHD# ;get ptr to head of list of original stories
JRST AD0
AD1: HLRZ X1,(D) ;get index ptr of this list element
MOVEI PT3,SORDID(SOR) ;get ptr to header of main list
JRST AD2
AD3: HLRZ X,(B) ;get index ptr of this element
CAMN X,X1 ;is it same story?
JRST AD4 ;yes. nothing special to do
CAMG X,NEWX ;no. is X in top part of INDEX?
JRST AD5 ;yes
CAML X,X1 ;no (bottom part)
CAMG X1,NEWX
JRST INSX
JRST AD6
AD5: CAMG X,X1 ;(X in top part)
CAML X1,NEWX
JRST AD6
INSX: PUSHJ P,GETAVL ;insert X1 at this point in main list
HRLI X1,(B) ;make new list element point to next one
MOVSM X1,(PT3)
JRST AD4
AD6: MOVE PT3,B ;advance down main list
AD2: HRRZ B,(PT3) ;get ptr to next element in main list
JUMPN B,AD3 ;at end of list?
JRST INSX ;yes. place X1 here
AD4: MOVE C,D
AD0: HRRZ D,(C) ;get ptr to next list element
JUMPN D,AD1 ;at end of list?
SKIPN A,ORIGHD
POPJ P,
; JRST RETLST ;return list to free storage
;RETLST returns a list to available list storage. call is done like:
;;; SKIPE A,<address of list header>
;;; PUSHJ P,RETLST
;The header of the list is NOT cleared.
RETLST: MOVE C,A ;put ptr to first element of ret'd list
EXCH C,AVSLST ; in header for avail list
RET1: HRRZ B,(A) ;next element in list
JUMPE B,RET2 ;at end of list?
HRRZ A,(B) ;no. next element in list
JUMPN A,RET1 ;at end of list?
MOVE A,B ;yes
RET2: HRRZM C,(A) ;link up ret'd list with old avail list
POPJ P,
;SETUPI SETUP NEXT1 NEXT2
SETUPI: HRLM SOR,(P)
PUSHJ P,GETCH
PUSHJ P,PRIMAR
JRST SET0
SETUP: HRLM SOR,(P)
PUSHJ P,GETCH
PUSHJ P,FACTOR
SET0: TLZ F,OP1FLG+OP2FLG
HLRZ A,(P)
CAIE SOR,1(A)
UBIGERR 122 ; ;ARGUMENTS NOT ADJACENT ON STACK
HRRE PT1,SORDID(A)
HLLZS SORDID(A)
HRRE PT2,SORDID(SOR)
MOVE SOR,A ;POP SECOND ARG OF EXPRESSION OFF STACK
MOVEI PT3,SORDID(SOR)
JUMPLE PT1,SET1
TLO F,OP1FLG
MOVEM PT1,HEAD1
HLRZ X1,(PT1)
JRST SET2
SET1: MOVN PT1,PT1
HRRZ X1,LINKS+1(PT1)
SETZM HEAD1
SET2: JUMPLE PT2,SET3
TLO F,OP2FLG
MOVEM PT2,HEAD2
HLRZ X2,(PT2)
POPJ P,
SET3: MOVN PT2,PT2
HRRZ X2,LINKS+1(PT2)
SETZM HEAD2
POPJ P,
NEXT1: TLNE F,OP1FLG
JRST NEXT11
HLRZ PT1,LINKS(PT1)
HRRZ X1,LINKS+1(PT1)
POPJ P,
NEXT11: HRRZ PT1,(PT1)
HLRZ X1,(PT1)
POPJ P,
NEXT2: TLNE F,OP2FLG
JRST NEXT21
HLRZ PT2,LINKS(PT2)
HRRZ X2,LINKS+1(PT2)
POPJ P,
NEXT21: HRRZ PT2,(PT2)
HLRZ X2,(PT2)
POPJ P,
;SDIFF
SDIFF: PUSHJ P,SETUP ;this must be first instr in SDIFF (see LOOK)
SD0: JUMPE PT1,FINISH
JUMPE PT2,COPY1
CAME X1,X2
JRST SD4
PUSHJ P,NEXT1
PUSHJ P,NEXT2
JRST SD0
SD4: CAML X1,OLDX
JRST SDBOTT
CAMG X1,X2
JRST SD1
SD2: PUSHJ P,GETAVL
HRLM X1,(PT3)
PUSHJ P,NEXT1
JRST SD0
SD1: CAML X2,OLDX
JRST SD2
SD3: PUSHJ P,NEXT2
JRST SD0
SDBOTT: CAML X2,OLDX
CAMG X1,X2
JRST SD3
JRST SD2
;UNION
UNION: PUSHJ P,SETUP
UN0: JUMPE PT1,COPY2
JUMPE PT2,COPY1
CAME X1,X2
JRST UN4
PUSHJ P,GETAVL
HRLM X1,(PT3)
PUSHJ P,NEXT1
PUSHJ P,NEXT2
JRST UN0
UN4: CAML X1,OLDX
JRST UNBOTT
CAMG X1,X2
JRST UN1
UN2: PUSHJ P,GETAVL
HRLM X1,(PT3)
PUSHJ P,NEXT1
JRST UN0
UN1: CAML X2,OLDX
JRST UN2
UN3: PUSHJ P,GETAVL
HRLM X2,(PT3)
PUSHJ P,NEXT2
JRST UN0
UNBOTT: CAML X2,OLDX
CAMG X1,X2
JRST UN3
JRST UN2
;INTER
INTER: PUSHJ P,SETUPI ;this must be first instr in INTER (see LOOK)
INT0: JUMPE PT1,FINISH
JUMPE PT2,FINISH
CAME X1,X2
JRST INT4
PUSHJ P,GETAVL
HRLM X1,(PT3 ∩4∀∪!+M⊃∀∪ 1≥ 1(D~∀∪!U'⊃∀∪@Y≥ 1Pd~∀∪)%'(∪%≥(`~)∪≥(hh∪πβ≠0∪0bY=→ 0~(∪∃%'P∪∪≥¬=)(~∀%πβ≠∞%0bY0H~∀∪∃I'(∪∪9(b~∃%≥(dt%!+'⊃(∪ Y≥∃1(b~(∪∃%'P∪∪≥(@~∃∪≥Pbt∪π¬≠_∪0HY∨→ `~∀∪∃I'(∪∪9(d~∃%≥(ft%!+'⊃(∪ Y≥∃1(d~(∪∃%'P∪∪≥(@~∃∪≥ ∨)(t%πβ≠_%0dY∨1 0~∀%πβ≠∞%0bY0H~∀∪∃I'(∪∪9(f~∀%∃%'(%∪≥(d4∀_wπ∨A2b∪π=!2d∪→∪≥∪' ~∀~∃
∨!2bh∪∃+≠A
∪!(DY
∪≥%'⊂~∀%)→≥
% Y∨ E
→∞~(∪∃%'P∪π∨ Dd~∃π= bbt%!+'⊃(∪ Y∂∃)β-_4∀∪⊃%1~∪0b0Q!(f$~∀∪⊃1%4∪!PbY→∪9↔&Q!PbR~∀%⊃%%4%0bY→%≥↔&VDQ!(b$~∀∪∃U≠!≤∪A(bYπ= bb~(∪∃%'P∪
∪≥%'⊂~∃
∨ bdh∪!+'!∀∪ Y≥ )β-0~∀∪⊃I→~∪0DXQ!(LR~∀∪!%%4∪A(bXQA(bR~(∪⊃→%h∪0bX!!(bR4∀∪∃+5!≤∪!PbYπ∨@bd~∀%∃%'(%
∪≥∪M⊂~∀~)π∨!2Ht∪∃+5!
∪!PdY
∪9∪'⊂~(∪)→≥∀∪ Y∨@e
→∞4∀∪∃%M(∪π∨@dd~∃
∨ dbh∪!+'!∀∪ Y≥ )β-0~∀∪⊃I→~∪0HXQ!(LR~∀∪!→%4∪A(dY→%≥↔&QA(dR~(∪⊃%%h∪0dY1∪≥↔&,bQ!(HR~∀∪)+≠!≤%!(dY
∨ db4∀∪∃%M(∪
∪9∪'⊂~)π∨ dHt∪!+M⊃∀∪ 1∂ )βY_~∀∪!%→~∪`dXQ!PfR~∀%⊃%%4%!(dX!!(dR4∀∪⊃→I4∪0d0Q!(d$~∀∪∃U≠!≤∪A(dYπ= dd~(~∃
∪9∪'⊂t%⊃→→5L∩Q!(LR∩∩∩makhA9kYXAAidA←8AK]H↓←LAe∃gkYi¬]hAY%gh~∀%'↔∪!∀∪αY⊃∃βλb∩$∩wSf↓MSegPAYSgPA]kY0}~∀∪A+'⊃∀% Y% Q→'(∩$w]↑\AeKiUe\ASPAi↑A→eKJAMi←eC≥J~∀∪M↔∪!
%αY⊃ ¬λd∩∩$wSfAMKG←]⊂AYSgPA]kY0}~∀∪)%'(∪I )→'P∩∩∩w9↑\@AIKike8AShAQ↑AMe∃JAgi=eCOJ4∀∪!∨A∀∪ X4∀ ;LATEST SEQNBR
;build up a list of the latest n stories, where n is a number typed in.
LATEST: PUSHJ P,INNBR ;read in nbr of stories to be found. put into B
LAT1: MOVEI PT3,SORDID(SOR) ;set up list ptr to header of list
JUMPN B,.+2
MEDERR (MISSING OR ZERO COUNT AFTER ".") ; ;
MOVEM B,SAVCNT#
MOVE X,NEWX ;get index of NEW area
LAT3: CAMN X,OLDX ;check if index has run into OLD
JRST LAT4 ;it has. no more stories can be retrieved
SUBI X,XSIZE ;get previous index entry
CAIGE X,SPECS
MOVEI X,XLEN-XSIZE
PUSHJ P,GTORIG ;put original for this story onto the list
SOSLE SAVCNT ;have enough stories been found?
JRST LAT3
SEQ2:LAT4:HLLZS (PT3) ;yes. put null ptr at end of list
PUSHJ P,ADORIG ;add to the list any originals referenced
TLZE F,NOTIFY ;notification requested?
OUTSTR [ASCIZ/NOTIFICATION NOT POSSIBLE FOR EXPRESSIONS CONTAINING "." OR "#" CONSTRUCTS
/]
JRST GETCH1
;build up a list of the stories within a given range of sequence numbers
SEQNBR: PUSHJ P,INNBR ;read in the seq nbr (B)
MOVEM B,SEQBEG
CAIN CHAR,":" ;is this a range of seq nbrs?
PUSHJ P,INNBR ;yes. get seq nbr for end of range
JUMPN B,SEQ3 ;if the end nbr is 0 and the
SKIPE SEQBEG ; beginning nbr is not 0, then
MOVEI B,-1 ; ∞ is used for the end nbr
SEQ3: MOVEM B,SEQEND
SUB B,SEQBEG
MOVEM B,SAVCNT#
MOVEI PT3,SORDID(SOR) ;set up list ptr to header of list
MOVE X,NEWX ;get index of NEW area
SEQ1: CAMN X,OLDX ;has the index run into OLD already?
JRST SEQ2 ;yes. that's all the stories there are
SUBI X,XSIZE ;no. get index of previous story
CAIGE X,SPECS
MOVEI X,XLEN-XSIZE
HRRZ A,INDEX+2(X) ;get seq nbr for this story
CAMGE A,SEQBEG
JRST SEQ5
SKIPL SAVCNT
CAMG A,SEQEND
JRST SEQ4
JRST SEQ1
SEQ5: JUMPGE B,SEQ1
CAMG A,SEQEND
SEQ4: PUSHJ P,GTORIG ;put original for this story onto the list
JRST SEQ1 ;dont care whether story was on list
JRST SEQ1 ;go look for more stories
;GETSTY INNBR RDNBR PTZERO PRNTNO NXTDG PTREST
GETSTY: CAIE CHAR,"*" ;does the user want to reference the oldest story?
JRST RDNBR ;no. read in a story number
MOVE B,NFOUND ;yes. get the number of the oldest story
JRST GETCH
INNBR: ILDB CHAR,LINEBP ;load 1st char of number
RDNBR: SETZ B, ;B will hold the value of the number
RDNBR1: CAIG CHAR,"9" ;is present char a digit?
CAIGE CHAR,"0"
JRST GETCH1 ;no. return
IMULI B,=10 ;yes. multiply previous sum by =10 and
ADDI B,-60(CHAR) ; add in current digit
ILDB CHAR,LINEBP ;load the next potential digit
JRST RDNBR1
PTZERO: CAIGE PT1,=10
OUTCHR ["0"] ;print a leading zero if number is less than ten
PRNTNO: MOVE B,[POINT 7,DIGITS]
PUSHJ P,NXTDG
SETZ PT1,
IDPB PT1,B
OUTSTR DIGITS
POPJ P,
NXTDG: IDIVI PT1,=10
PUSH P,PT2
SKIPE PT1
PUSHJ P,NXTDG
POP P,PT1
ADDI PT1,60
IDPB PT1,B
POPJ P,
;type out remaining part of input line following an error
PTREST: OUTSTR [ASCIZ/: /]
JRST REST2
REST1: OUTCHR CHAR
ILDB CHAR,LINEBP
REST2: JUMPN CHAR,REST1
OUTSTR CRLF
POPJ P,
;PUTDAT CLEARU
PUTDAT: OPEN 16,DSK17
UBIGERR 124 ; ;OPEN FAILED ON DSK
MOVE A,PPN
MOVEM A,USEF+3
ENTER 16,USEF ;ENTER new USE.DAT
JRST NOUSE
PUSHJ P,GETDAT
JRST NOUSE
SETZ D,
CALLI D,27 ;RUNTIM
SUBM D,LOCDAT+CPUTIM ;calculate and store amount of cpu time used lately
MOVE B,[2-ULEN,,1]
NXTU: MOVE A,LOCDAT(B)
ADDM A,TOTDAT(B) ;add local data to grand totals kept in USE.DAT
AOBJN B,NXTU
MOVEI A,-ULEN
HRLM A,UCMD
OUT 16,UCMD
JRST .+2
JRST NOOUT ;OUTPUT FAILED
RELEAS 16,
CLEARU: SETZM LOCDAT
MOVE A,[XWD LOCDAT,LOCDAT+1]
BLT A,LOCDAT+ULEN-1
MOVEM D,LOCDAT+CPUTIM ;save total cpu time since login
POPJ P,
NOOUT: SUBM D,LOCDAT+CPUTIM ;put back earlier total cpu time since login
NOUSE: RELEAS 16,3
POPJ P,
;GETDAT PTIME
;read in usage data file
GETDAT: OPEN 15,DSK17
UBIGERR 130 ; ;OPEN FAILED ON DSK
MOVE A,PPN
MOVEM A,USEF+3
LOOKUP 15,USEF
JRST GETXIT
HLRE A,USEF+3 ;get size of data file
CAMGE A,[-ULEN] ;is it bigger than array?
MOVEI A,-ULEN ;yes. only read in enough to fill array?
HRLM A,UCMD ;store amount to read in
SETZM TOTDAT
MOVE A,[TOTDAT,,TOTDAT+1]
BLT A,TOTDAT+ULEN-1
IN 15,UCMD
AOS (P) ;skip return for success
GETXIT: RELEAS 15,
POPJ P,
;ROUTINE TO PRINT A TIME IN HOURS, MINUTES AND SECONDS AS HH:MM:SS
;CALL WITH TIME IN MILLISECONDS IN PT1. CLOBBERS PT1,PT2,B
PTIME: IDIVI PT1,=1000 ;convert time to seconds
IDIVI PT1,=60 ;convert time to minutes
PUSH P,PT2 ;save seconds
IDIVI PT1,=60 ;convert time to hours
PUSH P,PT2 ;save minutes
PUSHJ P,PTZERO ;print hours
OUTCHR [":"]
POP P,PT1 ;get minutes
PUSHJ P,PTZERO ;print minutes
OUTCHR [":"]
POP P,PT1 ;get seconds
JRST PTZERO ;print seconds and return
;PRINTU
PRINTU: PUSHJ P,GETDAT ;read in usage data file
POPJ P, ;couldn't read in file. give up
SETO A,
GETLIN A ;get tty line characteristics
TLNN A,420000 ;IS THIS GUY ON A DISPLAY?
JRST PU1 ;nope
DPYSIZ 0000 ;yup. move pp to top of screen
MOVEI A,1
SLEEP A, ;WAIT A SEC FOR DPYSIZ TO COMPLETE
PTWR1W [0↔14120] ;[BRK]P. clear screen
PTWR1W [0↔10116] ;[ESC]N. normalize pp
PU1: OUTSTR [ASCIZ \
DATA SINCE \]
LDB PT1,[POINT 11,TOTDAT,23] ;get time data cleared (in minutes)
IDIVI PT1,=60 ;hours into PT1, minutes into PT2
MOVE A,PT2 ;save minutes
PUSHJ P,PTZERO ;print hours
MOVE PT1,A ;get minutes
PUSHJ P,PTZERO ;print minutes
OUTCHR [" "]
PUSHJ P,PDATE ;print date data was cleared
OUTSTR CRLFS
MOVE C,[4-ULEN,,3]
TOPU: OUTSTR @MSGDAT(C) ;print name of a piece of data
MOVE PT1,TOTDAT(C)
PUSHJ P,PRNTNO ;print value of this data
OUTSTR CRLF
AOBJN C,TOPU ;get next piece of data, if any
OUTSTR [ASCIZ/
CPU TIME (HR:MIN:SEC).........../]
MOVE PT1,TOTDAT+CPUTIM
PUSHJ P,PTIME
OUTSTR [ASCIZ/
SEARCH TIME (HR:MIN:SEC).........../]
MOVE PT1,TOTDAT+SRCTIM
PUSHJ P,PTIME
OUTSTR CRLFS
POPJ P,
PDATE: LDB A,[POINT 12,TOTDAT,35] ;PRINT A DATE
IDIVI A,=31 ;months into A, days into B
MOVEI PT1,1(B) ;put day of month into PT1
PUSHJ P,PRNTNO ; and print it
IDIVI A,=12 ;years into A, months into B
OUTCHR ["-"]
OUTSTR MONTHS(B) ;print month
OUTCHR ["-"]
MOVEI PT1,=64(A) ;put year in PT1
JRST PRNTNO ; and print it and return
;ZEROUS
ZEROUS: OUTSTR [ASCIZ \CLEAR? \]
INCHRW A
CAIE A,"%"
POPJ P,
INCHRW A
CAIE A,"π"
POPJ P,
OPEN 16,DSK17
UBIGERR 140 ; ;OPEN FAILED ON DSK
HLLZS USEF+1
SETZM USEF+2
MOVE A,PPN
MOVEM A,USEF+3
ENTER 16,USEF
JRST [RELEAS 16,
OUTSTR [ASCIZ \ FAILED
\]
POPJ P,]
CALLI A,400072 ;DSKTIM. get time/date
MOVEM A,TOTDAT
SETZM TOTDAT+1
MOVE A,[XWD TOTDAT+1,TOTDAT+2]
BLT A,TOTDAT+ULEN-1
MOVEI A,-ULEN
HRLM A,UCMD
OUT 16,UCMD
JRST .+2
UBIGERR 144 ; ;OUT UUO FAILED FOR USE.DAT
RELEAS 16,
OUTSTR [ASCIZ \ DONE\]
POPJ P,
;SAVPPN
SAVPPN: OPEN 14,DSK17
UBIGERR 150 ; ;OPEN FAILED ON DSK
MOVE B,PPN
MOVEM B,USERSF+3
LOOKUP 14,USERSF
JRST XPPN
HLRE A,USERSF+3
MOVE B,PPN
MOVEM B,USERSF+3
ENTER 14,USERSF
JRST XPPN
MOVN A,A
LDB B,[POINT 7,A,35]
ASH A,-7
JUMPE B,WRT
USETI 14,1(A)
MOVN C,B
HRLM C,PCMD
IN 14,PCMD
JRST .+2
JRST XPPN
WRT: USETO 14,1(A)
LDB A,[POINT 6,USRPPN,23]
TRCE A,40
TRO A,100 ;convert PPN from SIXBIT to ASCII
DPB A,[POINT 7,USERS(B),6]
LDB A,[POINT 6,USRPPN,29]
TRCE A,40
TRO A,100
DPB A,[POINT 7,USERS(B),13]
LDB A,[POINT 6,USRPPN,35]
TRCE A,40
TRO A,100
DPB A,[POINT 7,USERS(B),20]
MOVEI A," " ;put a space after the PPN
DPB A,[POINT 14,USERS(B),34]
SETZM USERS+1(B)
MOVNI B,2(B)
HRLM B,PCMD
OUTPUT 14,PCMD
TRO F,PPNDUN
XPPN: RELEAS 14,
POPJ P,
;READIT
READIT: HRRZ DISPL,INDEX+1(X) ;get the story's displ from beginning of rec
MOVE SIZE,X ;calculate the index of the next story
ADDI SIZE,XSIZE
CAIL SIZE,XLEN
MOVEI SIZE,SPECS
MOVN SIZE,INDEX+1(SIZE) ;subtract the rec nbr and displ of next story from zero
ADD SIZE,INDEX+1(X) ; and add in the rec nbr and displ of the
JUMPL SIZE,ONWARD ; current story. this gets negated size of current story
DOWN: MOVN SIZE,INDEX+3 ;the current story is the bottom one in NEWS
JUMPE SIZE,CPOPJ ;zero means this is a fake story. NEWS has never wrapped around
ADD SIZE,INDEX+1(X) ;recalculate its size using ptr to bottom of file
ONWARD: ASH SIZE,-13 ;shift out the =11 low order zero bits of the size
ASH DISPL,-13 ;shift out the =11 low order zero bits of the displ
MOVNM SIZE,TOTSIZ# ;save the size of the story (positive size)
SUB SIZE,DISPL ;add in the displ to get the amt that has to be read in
HRLM SIZE,CMD ;store this amt (negated) in the input command
AGAIN1: OPEN 4,DSK17 ;LOOKUP the NEWS file for reading in the story
UBIGERR 154 ; ;OPEN FAILED ON DSK
MOVE A,PPN
MOVEM A,NEWSF+3 ;store ppn of [ap,sys] in lookup block
LOOKUP 4,NEWSF
JRST [RELEASE 4, ;NEWS file in use. wait and try the LOOKUP again
MOVEI A,1
CALL A,[SIXBIT /SLEEP/]
JRST AGAIN1]
HLRZ A,INDEX+1(X) ;get the record nbr for this story
USETI 4,(A) ;select that record for input from NEWS
IN 4,CMD ;read in the story in STORY area
JRST .+2
UBIGERR 160 ; ;IN UUO FAILED TO READ IN NEWS STORY
RELEAS 4,
ADDI DISPL,STORY ;make DISPL into ptr to first word of the story
LDB B,[POINT 7,(DISPL),6] ;CALCULATE APPARENT SEQ NBR OF STORY READ
SUBI B,60 ; IN FROM NEWS
IMULI B,=10
LDB C,[POINT 7,(DISPL),13]
ADDI B,-60(C)
IMULI B,=10
LDB C,[POINT 7,(DISPL),20]
ADDI B,-60(C)
HRRZ A,INDEX+2(X) ;GET SEQ NBR FROM INDEX FOR THIS STORY
CAMN A,B ;CHECK CALCULATED SEQ NBR AGAINST THAT IN INDEX
CPOPJ1: AOS (P)
CPOPJ: POPJ P,
;SEARCH
CH←←0
BP←←1
J←←2
TEST←←3
SAVACS: BLOCK 20 ;block for storing AC during search in ACs
SEARCH: PUSHJ P,READIT
JRST SRCXIT ;story has disappeared, so keyword not found
AOS NBRSRC ;count number of stories searched
SETZM FNDIT#
MOVEM 17,SAVACS+17
MOVE 17,[XWD 0,SAVACS]
BLT 17,SAVACS+16 ;save the ACs
MOVE BP,DISPL
HRLI BP,440700 ;set up byte pointer into story
MOVE 17,[XWD CODE,4]
BLT 17,17 ;move loop code into ACs
JRST NX ;jump into loop
CODE:
PHASE 4 ;this code will go into ACs 4 to 17
NX←←. ILDB CH,BP
CAIE CH,
CAIN CH,
JRST GOT1
NX1←←. JUMPN CH,NX
JRST EOS ;found end of story without finding keyword
NX2←←. ILDB CH,BP ;CH holds char from story
ANDI CH,137 ;make upper case
ILDB TEST,TESTB# ;TEST holds char from keyword
CAIN CH,(TEST)
NX3←←. SOJGE J,NX2
JRST GOTALL
DEPHASE
GOT1: SETZM END#
MOVE J,MINBP
MOVEM J,TESTB
MOVE J,NEND
JRST NX3
GOTALL: JUMPGE J,NOHIT
SKIPE END
JRST HIT
SETOM END
MOVEM BP,SAVBP#
ILDB CH,BP ;get char after last char in possible keyword
CAIL CH,"A" ;is it a word delimiter?
JRST NOHIT ;no. it's a letter
CAIGE CH,"0"
JRST .+3
CAIG CH,"9"
JRST NOHIT ;no. it's a digit
SUB BP,WDIF
SKIPA J,BDIF
IBP BP
SOJGE J,.-1
LDB CH,BP ;get char before first char in possible keyword
CAIL CH,"A" ;is it a word delimiter?
JRST NOHIT ;no. it's a letter
CAIGE CH,"0"
JRST .+3
CAIG CH,"9"
JRST NOHIT ;no. it's a digit
MOVE J,FSTBP
MOVEM J,TESTB
MOVE J,NBEG
JRST NX3
NOHIT: SKIPE END
JRST NOHIT1
LDB CH,BP
JRST NX1
NOHIT1: MOVE BP,SAVBP
JRST NX
HIT: SETOM FNDIT
EOS: MOVE 17,[XWD SAVACS,0]
BLT 17,17
SKIPN FNDIT
JRST SRCXIT
PUSHJ P,GTORIG ;found keyword in story, so link up original for
OUTCHR ["*"] ; this story
MOVE D,SAVACS+D ;GTORIG wipes out D
SRCXIT: SKIPE INTFG
JRST SRCHX1
TRNN F,FROMFL ;ARE WE READING FROM COMMAND FILE?
INCHSL GARBLE# ;NO. if user has typed a line, end search
POPJ P, ;has not typed a line. continue
CLRBFI ;clear the interrupting char(s) from tty buffer
SRCHX1: OUTSTR [ASCIZ/ Search terminated manually after /]
EXCH X,NBRSRC ;print number of stories searched
PUSHJ P,PRNTNO
MOVE X,NBRSRC ;restore X
OUTSTR [ASCIZ/ stories./]
AOS (P) ;skip return from SEARCH when interrupted
POPJ P,
;LOOK
F0: DEC 132,138,95,31,35,40,35,63,38,64
FA: DEC 1814,346,773,871,2597,456,402,760,1761,43,116,818,644
DEC 1746,1753,551,10,1459,1347,1897,548,294,292,88,313,17
LOOK0: OUTSTR CRLF
LOOK: AOS USCH ;bump counter of number of searches
SETZM INTFG
OUTSTR [ASCIZ/Searching.../]
SETZ A,
CALLI A,27 ;RUNTIM
MOVEM A,STTIM# ;save the cpu time to calculate search time
MOVEI A,-1
MOVEM A,MINFRQ# ;initialize min freq to large nbr
MOVE A,FSTBP#
SETO B, ;count nbr of chars - 1
LOOK3: ILDB C,A ;find least common char and convert
JUMPE C,LOOK4 ; all letters to upper case
ANDI C,137 ; by turning off 40 bit
DPB C,A
CAIGE C,"0"-40
AOJA B,LOOK3 ;neither a digit or a letter (must be space)
MOVE D,FA-101(C) ;get freq assuming letter
TRNN C,100
MOVE D,F0-20(C) ;get freq for digit
CAML D,MINFRQ ;less freq than any so far?
AOJA B,LOOK3 ;no
ADDI B,1
MOVEM D,MINFRQ# ;yes. save freq,
MOVEM A,MINBP# ; byte ptr,
MOVEM B,NBEG# ; nbr of chars before this,
MOVNM B,NEND# ; and negative of nbr of char before.
JRST LOOK3
IDPB C,A ;fill out word in POLISH with zero bytes
LOOK4: TLNE A,760000
JRST .-2
TLZ A,-1
SKIPN (A)
SUBI A,1
SUBI A,POLISH
MOVE C,POLPTR
SUB A,C
HRRZM A,POLISH(C) ;save length of search string in POLISH
HRLM A,POLISH(C) ;put length in both left and right halves
ADDB A,POLPTR ;adjust POLPTR to last word in string
CAIL A,POLLEN
HALT . ; ;
ADDM B,NEND#
LDB C,MINBP
ORI C,40
HRRM C,CODE+1
ANDI C,137
HRRM C,CODE+2
ADDI B,2
IDIVI B,5
JUMPE C,LOOK5
ADDI B,1
MOVN C,C
ADDI C,5
LOOK5: MOVEM B,WDIF# ;save number of words back front of string is
MOVEM C,BDIF# ;save number of IBPs to get to front of string
SETZM NBRSRC# ;zero out the number of stories searched
MOVEI PT3,SORDID(SOR)
MOVE A,P
JRST LOOK7
LOOK6: HRRZ B,(A)
CAIE B,SDIFF+1 ;is this the second part of a set diff?
CAIN B,INTER+1 ;no. second part of an intersection?
JRST GOTINT ;yes to one of these
SUB A,[1,,1]
LOOK7: CAME A,[IOWD PDLEN,PDLIST] ;have we searched entire stack?
JRST LOOK6 ;nope
MOVE X,NEWX
LOOK1: CAMN X,OLDX ;have we searched the oldest story yet?
JRST LOOK2 ;yes. finish up
SUBI X,XSIZE ;no. get index of next older story
CAIGE X,SPECS
MOVEI X,XLEN-XSIZE
PUSHJ P,SEARCH ;search the story for the keyword
JRST LOOK1
LOOK2: HLLZS (PT3) ;put null ptr on end of list
PUSHJ P,ADORIG ;add to list any originals referenced
OUTSTR CRLF
SETZ X,
CALLI X,27
SUB X,STTIM ;calculate search time and print it
ADDM X,LOCDAT+SRCTIM ;add to previous search time
OUTSTR [ASCIZ/Search time in msec: /]
PUSHJ P,PRNTNO
OUTSTR CRLF
JRST GETCH1
GOTINT: HLRZ D,(A) ;get ptr to story list for first part of expr
HRRE D,SORDID(D) ;get ptr to first story in list
JUMPGE D,GOTIN1 ;ptr < 0 means ptr into LINKS
MOVN D,D
JRST .+2
GOTIN2: HLRZ D,LINKS(D) ;get ptr to next element in list
JUMPE D,LOOK2 ;zero ptr means end of list
HRRZ X,LINKS+1(D) ;get index ptr for this story in list
PUSHJ P,SEARCH
JRST GOTIN2
JRST LOOK2
GOTIN3: HRRZ D,(D) ;get ptr to next element in list
GOTIN1: JUMPE D,LOOK2
HLRZ X,(D) ;get index ptr for this story
PUSHJ P,SEARCH
JRST GOTIN3
JRST LOOK2 ;search was interrupted
;SHRINK UUCODE
SHRINK: HLRZ A,JOBSA
MOVEM A,JOBFF
CALLI A,11 ;CORE UUO to release extra core accumulated
UBIGERR 164 ; ;CORE UUO FAILED
POPJ P,
UUCODE: 0
HLRZ A,40 ;get type of error
ANDI A,777000 ;zero out AC field
; OUTCHR ["?"]
CAIN A,(<UBIGERR>) ;is it a super horrendous error?
JRST BADERR
OUTSTR @40
LDB B,[POINT 4,40,12]; pick up AC field of error UUO
JUMPE B,.+2
CLRBFI ;clear input buffer if AC field is non-zero
TRZ F,AUTOCN
CAIN A,(<UERR3>)
JRST REESET
PUSHJ P,PTREST
CAIN A,(<UERR2>)
JRST RSTART
CAIN A,(<UERR1>)
JRST APE1
BADERR: OUTSTR [ASCIZ/
SUPER HORRENDOUS ERROR #/]
HRRZ PT1,40 ;get error number
PUSHJ P,PRNTNO
CALLI 0
CALLI 12
;TELLKY TELLSL TELLSC
TELLKY: OUTSTR INFO1
PUSHJ P,READ
PUSHJ P,GETCH
CAIN CHAR,"?"
OUTSTR INFO2
JRST APE1
TELLSL: OUTSTR INFO3
PUSHJ P,READ
PUSHJ P,GETCH
CAIN CHAR,"?"
OUTSTR INFO4
JRST ASKER1
TELLSC: OUTSTR INFO5
TRZ F,AUTOSC
JRST ASKSRC
INFO1: ASCIZ %
DETAILED INFORMATION ON THIS PROGRAM IS IN THE FILE: APE.ME[S,DOC]
WAR represents all stories mentioning WAR.
WAR*PEACE represents all stories mentioning both WAR and PEACE.
WAR+PEACE represents all stories mentioning either WAR or PEACE.
WAR-PEACE represents all stories mentioning WAR but not PEACE.
.n (n an unsigned integer) represents the latest n stories.
#n represents all stories with AP sequence number n.
#n:m represents all stories with AP numbers from n to m.
@<filenm> means read expressions from the command file <filenm>.
@!<filenm>means automatically read from the command file <filenm>.
@ means read another expression from the command file
(opens the file APE.CMD if no command file open).
@! means automatically read expressions from the command file
(opens the file APE.CMD if no command file open).
$<expr> means request automatic notification for the <expr>.
$ means display all current automatic notification requests.
$$ means allow deletion of automatic notification requests.
NOW type ? and RETURN to get MORE HELP, else type just RETURN.%
INFO2: ASCIZ %
Each keyword represents a group of stories, namely all the stories
it occurs in. A keyword expression consists of either a single
keyword or an expression built from keywords and the operators
* (for INTERSECTION), + (for UNION), and - (for SET DIFFERENCE).
These operators have their usual precedences (* evaluated first).
Note that + and - are BINARY operators only. Parentheses can be
used freely in keyword expressions.
The special forms ".n" (latest n stories), "#n" (stories numbered n),
and "#n:m" (stories numbered from n to m) can appear anywhere in
place of a keyword.
For a list of the keywords, read the file WORDS.SRT[AP,SYS]. To have
your own special keywords added to the list, MAIL a note to ME.%
INFO3: ASCIZ %
Syntax for the selection line is as follows, where [...] denotes
an optional quantity and ...|... denotes exclusive alternatives:
(The order is irrelevant except that any filename must come first.)
[<filenm>[/Q|/X]←] [<story selection>] [S] [K] [W] [C|F|L|D]
<filenm> means save stories in given file (no extension or PPN allowed).
/Q means replace file if it already exists.
/X means extend file if it already exists.
The syntax for <story selection> is:
[ N | [=]<nbr>[:<nbr>] ]
where <nbr> is a positive or negative integer (k represents the k newest
stories and -k represents the k oldest stories) and
= means reverse the order of the stories and
N means select None of the stories.
S means Spool the selected stories (not allowed with F or L options).
K means Kill automatic reading from command file.
W means type out the keyWords each story is categorized by.
C means allow Choosing which stories get typed out completely.
F means type out only the First few lines of each story.
L means type out only the Last few lines of each story.
D means Dont type out the stories at all (useful if filing or spooling).
NOW type ? and RETURN to get MORE HELP, else type just RETURN.%
INFO4: ASCIZ %
If you use the Choose feature, the first few lines of each story will
be typed out and then you will be expected to indicate whether you want
to read the rest of the story. If you do not want to read the rest of
the story, type just carriage return. To read the rest of the story,
type altmode, linefeed, or any character (except "I") followed by
carriage return. If you don't want to read any more of the stories,
type "I" and carriage return. You will be allowed to quit reading a
story at the beginning of each part (take, correction, etc.).
In the <story selection>:
To select the k newest stories in normal order, type the number "k".
To select the k oldest stories in normal order, type the number "-k".
To select the jth story thru the kth story, type "j:k". Note that
in this construction, "1" represents the newest story, larger
numbers represent older stories, "*" represents the oldest story,
and finally, "-k" represents the kth oldest story. Thus, "-1" is
equivalent to "*"; both represent the oldest story. The stories
will come out in the order you specify: story j first, story k
last.
For even more help, read the file APE.ME[S,DOC].
%
INFO5: ASCIZ %
A search of the news file is available for words that are not in the
keyword dictionary. Multiple word keyword searches are also possible
but occurrences that are split between lines will not be found. It
takes about 8 to 10 secs of computer time PER unknown keyword to
search the whole news file. However, if an unknown keyword occurs
as the SECOND part of an intersection or difference (eg, NIXON * JJJJ
or NIXON - JJJJ), then only the necessary stories are searched (in
the examples, only those stories containing NIXON).
During a search for a keyword, each time a story is found that
contains the keyword, an asterisk (*) is typed out. You may inter-
rupt the search at any time by typing [ESC] I or carriage return.
Any stories found up to that point will be available. Stories are
searched in the order of newest to oldest. To get a search, answer
the question below with a Y and carriage return; type ? and return
to get this summary and just carriage return to avoid a search.
%
;NOTE
NOTE: PUSHJ P,NOTPPN ;is this guy allowed to make notif requests?
PUSHJ P,COPYAD ;YES. Make a copy of his old requests.
JRST NOTE1 ;COPYING SUCCESSFUL
JRST NOTERJ ;ENTER FAILED. TELL HIM REQUEST REJECTED
JRST NOTERJ ;REQUEST FILE INPUT ERROR ON COPYING
NOTE1:
COMMENT ⊗ HERE IS HOW WE USED TO DO THIS! USED TO NEED RQBUF!!!! NOT NOW, THOUGH
SETOM RQBUF ;first two words of a request are -1
SETOM RQBUF+1
DATE B, ;WHAT DAY IS THIS?
ADDI B,2*=31 ;let request live two months
HRL B,USRPPN ;get programmer name of this guy
MOVSM B,RQBUF+3 ;save date,,programmer name in request
AOS A,POLPTR ;get number of words for polish expression
HRL A,A ;and save it for request
MOVEM A,RQBUF+2 ;also prepare to save total length of request
MOVEI B,3 ; including 7 special words less first 4
ADDM B,RQBUF+2
MOVE B,[POLISH,,RQBUF+4] ;BLT polish expression into output buffer
BLT B,RQBUF+3(A)
SETZM RQBUF+4(A) ;first word after polish is a zero
END OF COMMENT ⊗
MOVE B,[POINT 7,TMPBUF]
ILDB C,B
CAIE C,"$" ;replace the $ in expr with a (
JRST .-2
MOVEI C,"("
DPB C,B
MOVE B,LINEBP ;(LINEBP now points at zero byte after keyw expr)
MOVEI C,")" ;add a ) after keyw expr
DPB C,B
TDZA C,C
IDPB C,B ;deposit zero bytes until end of word
TLNE B,760000
JRST .-2
MOVEI B,1-TMPBUF(B) ;compute length of keyw expr
SETO A, ;FIRST TWO WORDS IN NEW RQ ARE -1
PUSHJ P,PUTADD
PUSHJ P,PUTADD
AOS A,POLPTR ;LENGTH OF POLISH INTO A AND POLPTR
HRL A,A ;COPY RH OF A INTO LH
ADDI A,3(B) ;INCLUDE 3 SPECIAL WORDS IN COUNT
PUSHJ P,PUTADD ;PUT OUT THE LENGTH WORD (THIRD WORDS OF RQ)
DATE A, ;GET TODAY'S DATE
ADDI A,2*=31 ;ADD TWO MONTHS (SO WHAT IF WE HAVE FEB. 31)
HRL A,USRPPN ;USER'S PROGRAMMER NAME INTO LH OF A
MOVS A,A ;PN INTO RH, DATE INTO LH
PUSHJ P,PUTADD ; AND PUT OUT THIS WORD (FOURTH WORD)
MOVN C,POLPTR ;GET NEGATIVE OF LENGTH OF POLISH
MOVSI C,(C) ; AND SET UP AOBJN PTR
MOVE A,POLISH(C) ;GET NEXT WORD OF POLISH
PUSHJ P,PUTADD ; AND OUTPUT IT
AOBJN C,.-2 ;GOT ALL OF POLISH?
SETZ A, ;YES. PUT OUT A ZERO WORD AFTER POLISH
PUSHJ P,PUTADD
MOVN B,B ;NEGATE THE LENGTH OF KEYW EXPR
MOVSI B,(B) ; AND MAKE INTO AOBJN PTR
MOVE A,TMPBUF(B) ;GET NEXT WORD OF KEYW EXPR
TRZ A,1 ; ZERO BIT 35 SO WE DONT GET A LINE NUMBER
PUSHJ P,PUTADD ; AND OUTPUT IT
AOBJN B,.-3 ;GOT ALL OF KEYW EXPR?
MOVEI A,-1 ;YES. FOLLOW WITH A WORD CONTAINING 0,,-1
PUSHJ P,PUTADD
SETZ A, ;AND THEN A ZERO WORD
PUSHJ P,PUTADD
COMMENT ⊗ MORE OLD METHOD. THE CODE ABOVE IS THE NEW METHOD STUFF.
ADDB B,RQBUF+2 ;and include in total length of request
ADDI A,RQBUF+5 ;prepare to blt keyword expression into
HRLI A,TMPBUF ; the request output buffer
BLT A,RQBUF+1(B) ;do it
MOVEI A,-1
MOVEM A,RQBUF+2(B) ;next to last word of request is 0,,-1
SETZM RQBUF+3(B) ;last word of request is 0
MOVNI B,4(B) ;negative length of request into B
MOVSI B,(B) ;set up AOBJN ptr to request being output
MOVE A,RQBUF(B) ;GET NEXT WORD OF REQUEST
PUSHJ P,PUTADD ;AND PUT IT INTO NEW <PN>.ADD
AOBJN B,.-2 ;FINISHED OUTPUTTING WHOLE REQUEST?
END OF COMMENT ⊗
MOVEI A,'EOF' ;AND FINALLY OUTPUT AN EOF MARKER
PUSHJ P,PUTADD
RELEAS 7, ;AND RELEASE NEW <PN>.ADD
AOS UNOTIF ;COUNT NBR OF REQUESTS MADE (SUCCESSFULLY)
OUTSTR [ASCIZ/Notification request accepted.
/]
POPJ P,
NOTERJ: OUTSTR [ASCIZ/Notification request REJECTED.
/]
POPJ P,
NOTPPN: HRRZ A,USRPPN ;see if this guy is allowed to make requests
CAIE A,'GUE' ;too many different GUEs
CAIN A,'SYS' ;same for SYSs
JRST NOTNOT
CAIE A,'FOO'
CAIN A,'100'
JRST NOTNOT
POPJ P,
NOTNOT: OUTSTR [ASCIZ/Sorry -- '/]
PUSHJ P,SIXOUT ;PRINT PROGRAMMER NAME
OUTSTR [ASCIZ/' cannot make notification requests.
/]
SUB P,[1,,1] ;RETURN UP TWO LEVELS
POPJ P,
;ROUTINE TO COPY OLD <PN>.ADD INTO NEW <PN>.ADD
;DIRECT RETURN ON SUCCESS
;SKIP RETURN IF CANNOT ENTER NEW <PN>.ADD
;DOUBLE SKIP RETURN IF INPUT ERROR FROM OLD <PN>.ADD
COPYAD: PUSHJ P,OPENAD ;OPEN OLD <PN>.ADD ON 10, NEW <PN>.ADD ON 7
AOS (P) ;ENTER FAILED
POPJ P, ;OLD <PN>.ADD NON-EXISTENT
JRST .+2 ;SUCCESS
COPYA1: PUSHJ P,PUTADD ;COPY THIS WORD INTO NEW <PN>.ADD
PUSHJ P,GNTF ;GET NEXT WORD FROM OLD <PN>.ADD
CAIE A,'EOF' ;FOUND EOF MARKER?
JRST COPYA1 ;NO. GO ON
RELEAS 10, ;YES. RELEASE OLD <PN>.ADD
POPJ P,
BUSY: OUTSTR [ASCIZ\
REQUEST DATA FILE BUSY. Type Y to try again?\]
PUSHJ P,READY ;DOES HE WANT TO TRY AGAIN?
POPJ P, ;YES
JRST BUSY1 ;"?"
AOS (P) ;NO. TAKE SKIP RETURN FROM BUSY
POPJ P,
BUSY1: OUTSTR [ASCIZ\
A file used for your programmer name is currently busy.
Someone with your name is making or deleting requests.
\]
JRST BUSY
;ROUTINE TO OPEN OLD <PN>.ADD ON CHANNEL 10 AND A NEW <PN>.ADD ON CHANNEL 7
;DIRECT RETURN IF ENTER FAILS
;SKIP RETURN IF OLD <PN>.ADD NON-EXISTENT
;DOUBLE SKIP RETURN ON COMPLETE SUCCESS
OPENAD: TLO F,DELB ;SET FLAG TO MAKE SURE WE ENTER NEW <PN>.ADD
OPENA1: HRRZ PT1,USRPPN ;SET UP LOOKUP/ENTER BLOCK
MOVSI PT2,'ADD'
TLNN F,DELB ;SHOULD WE ENTER NEW <PN>.ADD
JRST OPENA2 ;NO
OPEN 7,TBUF10
UBIGERR 170 ; ;OPEN FAILED ON DSK
SETZ PT3,
MOVE PT4,PPN
OPENA5: ENTER 7,PT1 ;CREATE NEW <PN>.ADD
JRST OPENA3 ;ENTER FAILED. ASSUME FILE BUSY
OPENA2: OPEN 10,MBUF10
UBIGERR 174 ; ;OPEN FAILED ON DSK
MOVE PT4,PPN
LOOKUP 10,PT1 ;GET OLD <PN>.ADD
JRST OPENA4 ;LOOKUP FAILED
JRST CPOPJ2 ;SUCCESS.
OPENA3: PUSHJ P,BUSY ;ENTER FAILED. DOES USER WANT TO TRY AGAIN?
JRST OPENA5 ;YES. GO DO IT
RELEAS 7, ;NO.
POPJ P, ;NO. TAKE DIRECT RETURN FROM OPENAD
OPENA4: TRNE PT2,-1 ;CHECK ERROR CODE FROM LOOKUP. FILE NON-EXISTENT?
UBIGERR 200 ; ;NO!
RELEAS 10,
AOS (P) ;YES. TAKE SKIP RETURN FROM OPENAD.
POPJ P,
;NOTEDL NOTEDP
;ROUTINE TO DISPLAY AND/OR ALLOW DELETION OF NOTIFICATION REQUESTS
;TMPB = REQUEST HAS BEEN DELETED
;TMPB2= REQUEST HAS BEEN FOUND
NOTEDL: TLOA F,DELB ;DISPLAY AND ALLOW DELETION
NOTEDP: TLZ F,DELB ;JUST DISPLAY REQUESTS
AOS UNDSPY
TRZ F,TMPB!TMPB2 ;access first file, no requests found yet
SETZM NDELS ;number of deletion requests in <pn>.DEL
HRRZ PT1,USRPPN ;set up LOOKUP/ENTER block for <pn>.DEL
MOVSI PT2,'DEL'
TLNN F,DELB ;are we deleting requests?
JRST NOTED1 ;NO. DONT ENTER NEW <PN>.DEL
OPEN 6,DSK17 ;CHANNEL FOR NEW <PN>.DEL
UBIGERR 204 ; ;
SETZ PT3, ;MAKE SURE NO PROTECTION
MOVE PT4,PPN
NOTED0: ENTER 6,PT1 ;NEW <PN>.DEL
JRST NOTED7 ;ENTER FAILED
NOTED1: MOVE PT4,PPN
OPEN 10,DSK17
UBIGERR 210 ; ;
SETOM OLDDEL ;ASSUME <PN>.DEL EXISTS
LOOKUP 10,PT1 ;OLD <PN>.DEL
JRST NOTED8 ;LOOKUP FAILED. FIND OUT WHY.
MOVS A,PT4 ;SAVE NEGATIVE WORD COUNT OF <PN>.DEL
JUMPL A,.+2
NOTED2: SETZB A,OLDDEL# ;ZERO WORD COUNT, FORGET IT
MOVNM A,NDELS ;STORE POSITIVE WORD COUNT
MOVE B,JOBFF ;EXPAND CORE TO FIT IN OLD <PN>.DEL + 100 NEW SPACES
HRRI PT4,-1(B) ;SET UP DMP MODE CMD ADDRESS (WD CNT ALREADY SET UP)
SETZ PT5, ;ZERO WORD AFTER COMMAND LIST
SUBI A,100 ;ADD ROOM FOR 100 NEW DELETIONS
MOVNM A,MAXDEL# ;SAVE SIZE OF DELETION TABLE
MOVSI C,D ;MAKE PTR TO DELETION TABLE--INDEX BY D
HRRI C,-1(B) ; WITH PTR TO LOC-1 IN RIGHT HALF
MOVEM C,DELPTR# ;SAVE THIS NICE NEW PTR
SUBB B,A ;NEW CORE SIZE
CORE B,
UBIGERR 220 ; ;CORE UUO FAILED!
MOVEM A,JOBFF ;SET NEW VALUE FOR JOBFF
SKIPE OLDDEL ;IF NO .DEL FILE, OR IF EMPTY .DEL FILE, DONT READ
IN 10,PT4 ;READ OLD <PN>.DEL INTO NEW CORE AREA
JRST .+2
UBIGERR 224 ; ;IN UUO FAILED TO READ IN OLD <PN>.DEL
OPEN 10,MBUF10 ;read in NOTIF and <pn>.ADD on this channel
UBIGERR 230 ; ;OPEN FAILED ON DSK
MOVE A,PPN
MOVEM A,NOTIFF+3
LOOKUP 10,NOTIFF ;NOTIF
JRST NOTED9 ;LOOKUP FAILED
PUSHJ P,DISPRQ ;DISPLAY AND/OR ALLOW DELETION OF REQUESTS IN NOTIF
JRST DELRQ ;WHERE TO GO TO DELETE A REQUEST FROM NOTIF
JRST NXRQ ;WHERE TO GO WHEN A REQUEST IS NOT DELETED
GETTAD: CLOSE 10,
HRRZ PT1,USRPPN ;SET UP LOOKUP BLOCK FOR <PN>.CHG
MOVSI PT2,'TAD'
MOVE PT4,PPN
LOOKUP 10,PT1
JRST GETADD
OUTSTR [ASCIZ\
(There are a few new requests that cannot be accessed right now.)
\]
GETADD: PUSHJ P,OPENA1 ;OPEN OLD <PN>.ADD ON CH 10, NEW <PN>.ADD ON CH 7
JRST NOTED5 ;ENTER FAILED
JRST NOTED4 ;OLD <PN>.ADD DOESN'T EXIST
PUSHJ P,DISPRQ ;DISPLAY AND/OR ALLOW DELETION OF REQUESTS IN .ADD
JRST NXRQ ;WHERE TO GO TO DELETE A REQUEST
JRST COPYRQ ;WHERE TO GO WHEN A REQUEST IS NOT DELETED
NOTED4: TRNN F,TMPB2 ;ANY NOTIFICATION REQUESTS FOUND?
OUTSTR [ASCIZ\
No notification requests found.
\] ;NOPE
SETZ B, ;ASSUME NO CLOSE INHIBITING ON RELEASING NEW FILES
TLNE F,DELB ;ARE WE STILL ALLOWED TO DELETE REQUESTS?
TRNN F,TMPB ;YES. ANY REQUESTS DELETED?
JRST NOTED5 ;NO TO ONE OF THESE
MOVEI A,'EOF' ;PUT EOF MARKER AT END OF <PN>.ADD
PUSHJ P,PUTADD
AOS D,NDELS ;ADD A ZERO WORD AT END OF DELETION LIST
SETZM @DELPTR
MOVN D,D ;NOW WE OUTPUT THE NEW <PN>.DEL
HRLZ PT4,D ;SET UP DUMP MODE COMMAND--WORD COUNT
HRR PT4,DELPTR ; AND ADDRESS (LOC-1)
SETZ PT5, ;ZERO WORD AFTER DUMP MODE COMMAND
OUTSTR [ASCIZ\
That's all of your requests. Type Y to verify your deletions?\]
NOD4A: PUSHJ P,READY ;DOES HE VERIFY THEM?
JRST NOTED6 ;YES
JRST NOD10 ;"?". EXPLAIN WHAT IS GOING ON
NOTED5: MOVEI B,3 ;NO. INHIBIT CLOSING ON RELEASING NEW FILES
JRST NOD6B
NOTED6: TLNN PT4,-2 ;IS NEW .DEL FILE EMPTY?
JRST NOD6A ;YES
OUT 6,PT4 ;NO. WRITE OUT DELETIONS
JRST NOD6B
UBIGERR 234 ; ;OUTPUT FAILED TO WRITE OUT NEW <PN>.DEL
NOD6A: SETZ PT1, ;DELETE NEW <PN>.DEL
MOVE PT4,PPN
CLOSE 6,
RENAME 6,PT1 ;DELETE IT
UBIGERR 240 ; ;RENAME FAILED TO DELETE NEW <PN>.DEL
NOD6B: RELEAS 10, ;CLOSE OLD <PN>.ADD
RELEAS 7,(B) ;CLOSE NEW <PN>.ADD
RELEAS 6,(B) ;CLOSE NEW <PN>.DEL
PUSHJ P,SHRINK
JRST RSTART
NOTED7: PUSHJ P,BUSY ;ENTER FAILED ON <PN>.DEL. WANT TO TRY AGAIN?
JRST NOTED0 ;YES
RELEAS 6,3 ;NO
JRST RSTART
NOTED8: TRNE PT2,-1 ;LOOKUP FAILED ON <PN>.DEL. FILE NON-EXISTENT?
UBIGERR 244 ; ;NO
JRST NOTED2 ;YES
NOTED9: HRRZ B,NOTIFF+1 ;LOOKUP FAILED ON NOTIF. get LOOKUP error code
JUMPE B,GETTAD ;if no file, go on to next file
UBIGERR 250 ; ;NOTIF SHOULDN'T BE BUSY!
NOD10: OUTSTR [ASCIZ\
The requests you have just said to delete will be deleted if you type Y.\]
JRST NOD4A ;go read his answer
DISPRQ:
CRNXRQ: OUTSTR CRLF
NXRQ: MOVE A,[POINT 36,RQBUF];byte pointer for saving first part of rq
MOVEM A,TMPBP#
PUSHJ P,GNTF ;get the first word of the next request
IDPB A,TMPBP ;SAVE WORD OF RQ IN CASE RQ MUST BE COPIED
AOJN A,RQTEST ;if the first word is not -1, might be eof
PUSHJ P,GNTF ;pick up serial number of rq
IDPB A,TMPBP ;SAVE WORD OF RQ IN CASE RQ MUST BE COPIED
MOVEM A,SERIAL# ; and save it
PUSHJ P,GNTF ;pick up length word: P,,L
IDPB A,TMPBP ;SAVE WORD OF RQ IN CASE RQ MUST BE COPIED
HRRZ B,A ; and save the length L of the remainder of rq
CAIL B,5 ;make sure length not too small
CAIL B,200 ; and not too big
UBIGERR 254 ; ;LENGTH OF RQ OUT OF BOUNDS
PUSHJ P,GNTF ;pick up DATE,,PN
IDPB A,TMPBP ;SAVE WORD OF RQ IN CASE RQ MUST BE COPIED
HRRZ D,USRPPN
TRNN F,GOD
CAIN D,(A) ;does this rq belong to this user?
JRST SHOWRQ ;yes. show it to him and (maybe) let him delete it
RQCON: PUSHJ P,GNTF
SOJG B,RQCON ;SKIP TO ZERO AT END OF REQUEST
JUMPE A,NXRQ ;is it really zero?
JRST RQERR ;NO!!!!!!
RQTEST: CAIN A,'EOF'+1 ;WE AOJed this AC. Skip if it is our EOF marker.
JRST RQEOF ;EOF MARKER
RQERR: OUTSTR [ASCIZ\
***** ILL FORMAT IN REQUEST DATA FILE! *****
\]
TLZ F,DELB ;NO MORE DELETIONS IF FILE SCREWED UP
RQEOF: AOS (P) ;ALWAYS TAKE DOUBLE SKIP RETURN
AOS (P)
POPJ P,
SHOWRQ: HRRE PT1,SERIAL# ;SEE IF THIS REQUEST IS ALREADY MARKED FOR DELETION
JUMPLE PT1,SHOWR1 ;CANT BE. IT'S FROM <PN>.ADD
SKIPG D,NDELS ;GET CURRENT LENGTH OF DELETION TABLE
JRST SHOWR1 ;TABLE IS EMPTY
CAMN PT1,@DELPTR ;IS SERIAL NUMBER IN TABLE?
JRST RQCON ;YES. THIS REQUEST IS MARKED FOR DELETION
SOJG D,.-2 ;NOT HERE. MOVE UP TABLE
;***** SOMETIME WE MIGHT OFFER THE OPTION OF UNDELETING AN OLD REQUEST *****
;THIS WOULD BE DONE HERE BY MAKING THE JRST RQCON INTO A JRST UNDEL
SHOWR1: TRON F,TMPB2 ;NOTE THAT WE HAVE DISPLAYED A REQUEST NOW
OUTSTR [ASCIZ\
SERIAL PN Expiration Expression
\] ;WE HADN'T BEFORE NOW, THOUGH
JUMPLE PT1,.+2 ;IS THIS A REAL SERIAL NUMBER?
PUSHJ P,PRNTNO ;YES. PRINT IT
OUTCHR [TAB]
HLRZM A,TOTDAT ;save expiration date for printing
PUSHJ P,SIXOUT ;type out programmer name of requestor
OUTCHR [TAB]
PUSHJ P,PDATE ;print expiration date
OUTCHR [TAB]
MOVE B,[IOWD 200,TMPBUF];put asciz expression into TMPBUF for outstr'ing
SHOWR5: PUSHJ P,GNTF
IDPB A,TMPBP ;SAVE WORD OF RQ IN CASE RQ MUST BE COPIED
JUMPN A,SHOWR5 ;skip to zero word following polish expr
SHOWR6: PUSHJ P,GNTF
IDPB A,TMPBP ;SAVE WORD OF RQ IN CASE RQ MUST BE COPIED
TRZ A,1 ;DONT SET BIT 35 OF A WORD IN TMPBUF! (NO LINE NOS.)
PUSH B,A ;deposit a word of the asciz string into TMPBUF buf
TLNE A,-1 ;end of asciz string?
JRST SHOWR6 ;no. get next word
OUTSTR TMPBUF ;TYPE OUT THE ASCIZ STRING OF THE RQ
PUSHJ P,GNTF ;get last word of request
JUMPN A,RQERR ; which should be zero. IF IT'S NOT, ARGGGGG!!!
IDPB A,TMPBP ;SAVE WORD OF RQ IN CASE RQ MUST BE COPIED
TLNN F,DELB ;is he being allowed to delete requests?
JRST CRNXRQ ;NO. PUT OUT A CRLF AND GET NEXT RQ FROM FILE
SHOWR4: OUTSTR [ASCIZ\ Delete?\]
PUSHJ P,READY ;read answer
JRST SHOWR2 ;YES. DELETE THIS REQUEST
JRST SHOWR3 ;"?". EXPLAIN
CAIE A,"X" ;A contains the answering character
CAIN A,"x"
TLZ F,DELB ;FORGET ABOUT ALL THE DELETIONS WE HAVE MADE SO FAR
; CAIE A,"F" ;DOES HE WANT TO QUIT BEING ASKED ABOUT DELETIONS?
; CAIN A,"f"
; JFCL ;YES. THIS SHOULD SET A BIT, BUT FOR NOW *********
MOVE A,(P) ;GET ADDRESS OF TWO INSTRUCTIONS
XCT 1(A) ;DONT DELETE THE REQUEST--EXECUTE THE SECOND INSTR
HALT . ;SHOULD NEVER GET HERE
SHOWR2: TRO F,TMPB ;NOTE THAT A REQUEST HAS BEEN DELETED
AOS UNSTOP ;COUNT NUMBER OF REQUESTS DELETED
XCT @(P) ;EXECUTE THE FIRST INSTRUCTION OF PAIR--DELETE RQ
HALT . ;SHOULD NEVER GET HERE
SHOWR3: OUTSTR [ASCIZ\
Type Y to delete this request.
X to undelete the deletions you just indicated (if any).
Anything else means don't delete this request. \]
JRST SHOWR4
;DELETE A REQUEST FROM NOTIF BY PUTTING A DELETE-REQUEST REQUEST IN <PN>.DEL
DELRQ: AOS D,NDELS# ;MAKE DELETION TABLE 1 LONGER
CAML D,MAXDEL# ;IS THERE ENOUGH ROOM?
UBIGERR 260 ; ;NO
HRRZ A,SERIAL# ;GET SERIAL NUMBER OF REQUEST BEING DELETED
MOVEM A,@DELPTR# ;add a new entry into <pn>.DEL
JRST NXRQ ;now go get next request
COPYRQ: MOVE B,[POINT 36,RQBUF];copy a request from old <pn>.add to new <pn>.add
COPYR1: CAMN B,TMPBP ;Have we copied whole rq yet?
JRST NXRQ ;yup. go process next rq
ILDB A,B ;no. get next word in rq from buffer where saved
PUSHJ P,PUTADD ; and put it out in the new <pn>.add file
JRST COPYR1 ;here we go loop-de-loop
comment ⊗ a sample type-out:
ME 15-May-73 (NIXON*WAR) Delete? end of comment ⊗
;TYPE OUT THE SIXBIT CHARS IN RIGHT HALF OF AC A. DONT TYPE OUT SPACES (NULLS).
SIXOUT: MOVE B,[POINT 6,A,17]
SIX1: ILDB C,B ;GET NEXT SIXBIT CHAR
JUMPE C,SIX2 ;IF NULL, DONT TYPE IT
ADDI C,40 ;CONVERT TO ASCII
OUTCHR C ;TYPE IT
SIX2: TLNE B,770000 ;GOT 'EM ALL?
JRST SIX1 ;NO. GET NEXT ONE
POPJ P,
GNTF: SOSG MBUF+2 ;GET NEXT WORD FROM INPUT REQUEST FILE
IN 10,
JRST GNTF1
SUB P,[1,,1] ;EOF OR OTHER INPUT ERROR. RETURN UP A LEVEL TO
JRST RQERR ; THE ERROR MESSAGE PRINTOUT
GNTF1: ILDB A,MBUF+1 ;GET NEXT WORD OF RQ
POPJ P,
PUTADD: SOSG TBUF+2 ;PUT A WORD INTO NEW <PN>.ADD FILE
OUT 7,
JRST .+2
UBIGERR 264 ; ;DISK OUTPUT ERROR
IDPB A,TBUF+1
POPJ P,
;TYKEYS
TYKEYS: AOS UKEYS
MOVE D,[POINT 7,STORY]
HLRZ A,INDEX(X)
JUMPE A,[OUTSTR [ASCIZ/No Keywords
/]
JRST FINKEY]
TYKE1: MOVE B,A
HRRE B,LINKS(B)
JUMPG B,.-1
MOVN B,B
PUSHJ P,GETFAT
MOVEI C,CR
IDPB C,D
MOVEI C,LF
IDPB C,D
HLRZ A,LINKS+1(A)
JUMPN A,TYKE1
SETZ C,
IDPB C,D
OUTSTR STORY
FINKEY: TLNN F,DONT
OUTSTR [ASCIZ/- - - - - - - - - -/]
OUTSTR CRLF
POPJ P,
GETFAT: HLLZ C,DICT(B)
HLLM C,(P)
GETFA4: HLRZ C,DICT+2(B)
CAML C,DICLEN
JRST GETFA2
HRRZ SIZE,DICT+2(C)
CAME B,SIZE
JRST GETFA3
MOVE B,C
JRST GETFA4
GETFA3: HLRZ SIZE,DICT+1(C)
CAME B,SIZE
JRST GETFA2
MOVE B,C
PUSHJ P,GETFAT
GETFA2: HLRZ B,(P)
ADD B,[440700,,WORDS]
GETFA5: ILDB C,B
CAIN C,"@"
JRST GETFA6
IDPB C,D
JRST GETFA5
GETFA6: MOVEI C," "
IDPB C,D
POPJ P,
;READFL RFAUTO RFCON
TVLEAD: ASCIZ /COMMENT ⊗ VALID /]
CFILE: BLOCK 4
SCFILE: SIXBIT /APE/
SIXBIT /CMD/
BLOCK 2
CBUF: BLOCK 3
READFL: PUSHJ P,GETCH
TRZ F,AUTOCN
CAIE CHAR,"!"
JRST RF00
TRO F,AUTOCN
PUSHJ P,GETCH
RF00: JUMPN CHAR,OPENFL ;is there a file name?
TRNE F,INFILE ;no. is there an old file open?
JRST RFAUTO ;yes
TRZ F,CON
INIT 12,
SIXBIT /DSK/
CBUF
UBIGERR 270 ; ;CANT INIT THE DSK
SETZM SCFILE+3 ;read standard command file from user's area
LOOKUP 12,SCFILE
JRST RFERR5
OUTSTR [ASCIZ/[OPENING APE.CMD]/]
JRST RF11
RF01: PUSHJ P,RF5 ;read until semicolon
POPJ P, ;some error
TRNN F,INFILE ;hit eof yet?
POPJ P, ;yes
RFAUTO: TRNE F,CON ;no. did last expr end with a comma?
JRST RF01 ;yes
JRST RFCON ;no. get next expr
OPENFL: SETZM CFILE ;read in new file name and
SETZM CFILE+1 ; LOOKUP the new file
SETZM CFILE+3
MOVE B,[POINT 6,CFILE] ;byte ptr to deposit file name in LOOKUP bk
MOVEI C,6 ;max length of file name
PUSHJ P,RFNAM1 ;read in file name
JRST RF1 ;CR found
JRST RFEXT ;"."
JRST RFPPN ;"["
JRST RFERR2 ;","
RFEXT: MOVE B,[POINT 6,CFILE+1] ;byte ptr to deposit file name ext
MOVEI C,3 ;max length of ext
PUSHJ P,RFNAME ;read in file name ext
JRST RF1 ;CR found
JRST RFERR2 ;"."
JRST RFPPN ;"["
JRST RFERR2 ;","
RFPPN: MOVE B,[POINT 6,D] ;byte ptr to deposit project code
MOVEI C,3 ;max length of project
PUSHJ P,RFNAME ;read in project code
JRST RF6 ;CR found. use given project and disk PN
JRST RFERR2 ;"."
JRST RFERR2 ;"["
JRST RF7 ;","
LSH D,-6 ;right justify project in left half of D
RF6: SOJGE C,.-1
SETZ C,
DSKPPN C,
HRR D,C ;GET PROGRAMMER NAME FROM DSKPPN
MOVEM D,CFILE+3 ;store PPN
JRST RF1
LSH D,-6 ;right justify project in left half of D
RF7: SOJGE C,.-1
EXCH D,CFILE+3 ;store project and clear D
MOVE B,[POINT 6,D,17] ;byte ptr to deposit programmer name
MOVEI C,3 ;max length of programmer name
PUSHJ P,RFNAME ;read in programmer name
JRST RF0 ;CR found (or "]")
JRST RFERR2 ;"."
JRST RFERR2 ;"["
JRST RFERR2 ;","
RF0: JRST .+2
LSH D,-6
SOJGE C,.-1
HRRM D,CFILE+3 ;store programmer name
RF1: TRZ INFILE!CON
INIT 12,0
SIXBIT /DSK/
CBUF
UBIGERR 274 ; ;INIT FAILED ON DSK
SKIPN CFILE ;zero file name means use APE.CMD
SKIPE CFILE+1 ;must also have zero extension
JRST RF12
MOVSI A,'APE'
MOVEM A,CFILE
MOVSI A,'CMD'
MOVEM A,CFILE+1
RF12: LOOKUP 12,CFILE
JRST RFERR3
RF11: IN 12,
JRST .+2
JRST RFERR4
AOS UATFL
MOVE C,[POINT 7,TVLEAD] ;see if the file is in TV format
MOVE D,CBUF+1
RF2: ILDB A,C
JUMPE A,RFTV
ILDB B,D ;look at first few chars of file
CAMN A,B
JRST RF2
AOS CBUF+2
JRST RFCON ;not a TV file
RFTV: IN 12, ;find first record after TV directory page
JRST .+2
JRST RFERR4
ILDB CHAR,CBUF+1
CAIE CHAR,FF
JRST RFTV
RFCON: OUTCHR ["@"]
TROA F,TYPEFL
RF5: TRZ F,TYPEFL
TRO F,INFILE+AUTOSC
MOVE B,[POINT 7,TMPBUF]
MOVEM B,LINEBP
RF3: SOSG CBUF+2 ;buffer used up?
IN 12, ;yes. get another
JRST RF4
RELEAS 12, ;eof (assume so anyway)
PUSHJ P,SHRINK
TRZ F,INFILE!AUTOCN!CON
JRST ENDFIL
RF4: ILDB CHAR,CBUF+1 ;get char from buffer
MOVE A,@CBUF+1 ;get whole word to test for SOS line number
TRNE A,1 ;is this an SOS line number?
JRST [MOVNI A,6 ;yes. advance byte pointer and byte
ADDM A,CBUF+2 ; count to first char after the
AOS CBUF+1 ; tab that follows line number
ILDB CHAR,CBUF+1
JRST .+1]
JUMPE CHAR,RF3 ;ignore nulls,
CAIE CHAR,CR ;carriage returns,
CAIN CHAR,LF ;line feeds,
JRST RF3
CAIN CHAR,FF ;and form feeds.
JRST RF3
CAIN CHAR,"," ;break on comma
JRST CONXPR
CAIN CHAR,";" ; or semicolon.
JRST ENDXPR
IDPB CHAR,B ;accept any other characters
JRST RF3 ;get next char from file
CONXPR: TROA F,CON ;note that command line continues (comma)
ENDXPR: TRZ F,CON ;note that command line ended (semicolon)
ENDFIL: SETZ CHAR,
IDPB CHAR,B ;place null byte at end of line
TRNE F,TYPEFL
OUTSTR TMPBUF ;type out the line from the file
TRNN F,INFILE ;have we hit eof?
OUTSTR [ASCIZ/[EOF]/] ;yes. tell the poor guy
TRNE F,TYPEFL
OUTSTR CRLF
MOVEI A,CR
MOVEM A,BRCHAR ;pretend command line ended with CR
AOS (P) ;success return
POPJ P, ;done at last!
;RFERR1-5 RFNAME
RFERR1: SUB P,[1,,1]
RFERR2: OUTSTR [ASCIZ/ILLEGAL FILE SPECIFICATION/]
JRST PTREST
RFERR3: OUTSTR [ASCIZ/CANT FIND COMMAND FILE
/]
POPJ P,
RFERR4: OUTSTR [ASCIZ/COMMAND FILE INPUT ERROR
/]
POPJ P,
RFERR5: OUTSTR [ASCIZ/NO COMMAND FILE OPEN
CANT FIND APE.CMD
/]
POPJ P,
RFNAME: PUSHJ P,GETCH
RFNAM1: JUMPE CHAR,CPOPJ ;end of file name specification?
CAIN CHAR,"." ;no. beginning of extension?
JRST CPOPJ1 ;yes. skip return
CAIN CHAR,"[" ;no. beginning of ppn?
JRST CPOPJ2 ;yes. double skip return
CAIN CHAR,"," ;no. end of project
JRST CPOPJ3 ;yes. triple skip return
CAIN CHAR,"]" ;no. end of ppn
POPJ P, ;yes. direct return
SOJL C,RFERR1 ;no. file name specification too long?
TRZ CHAR,40 ;no. convert char to sixbit
TRZE CHAR,100
TRO CHAR,40
IDPB CHAR,B ;save this sixbit char
JRST RFNAME
CPOPJ3: AOS (P)
CPOPJ2: AOS (P)
JRST CPOPJ1
PATCH: BLOCK 20 ;PATCH AREA
END APE